Delphi Magazine Collection 2001

home *** CD-ROM | disk | FTP | other *** search

/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue63 / Debug / HVBordebug / HVBorDebug.pas < prev next >

Wrap

Pascal/Delphi Source File | 2000-10-01 | 102.4 KB | 3,250 lines

unit HVBorDebug; { Simplified class interface for the BorDebug API Written by Hallvard Vassbotn (hallvard.vassbotn@c2i.net), April 1999 - September 2000 History: 15.04.99 HV Created 30.09.00 HV Updated and revised } interface uses Windows, Classes, TypInfo, BorDebug, SysUtils; type HVBorDebugError = class(Exception); HVBorDebugIndexError = class(HVBorDebugError); HVBorDebugSectionError = class(HVBorDebugError); // These are record types used to encapsulate the information transported // between the BorDebug APIs without the overhead of creating proper // class instances PBorDebugSubSection = ^TBorDebugSubSection; TBorDebugSubSection = record SubsectionType : TSubsectionType; Module : TModuleIndex; Offset : TFileOffset; Size : TByteCount; end; PBorDebugModuleSegment = ^TBorDebugModuleSegment; TBorDebugModuleSegment = record LinkerSegment : TLinkerSegmentIndex; Offset : TFileOffset; Size : TByteCount; Flags : TSegmentFlags; end; PBorDebugSymbol = ^TBorDebugSymbol; TBorDebugSymbol = record Kind : TSymbolKind; Offset : TFileOffset; Len : TByteCount; end; PBorDebugType = ^TBorDebugType; TBorDebugType = record TypeIndex : TTypeIndex; TypeOffset : TFileOffset; Length : TByteCount; TypeKind : TTypeKind; end; PBorDebugGlobalSymbol = ^TBorDebugGlobalSymbol; TBorDebugGlobalSymbol = record SymHashFunction : TNameIndex; AddrHashFunction : TNameIndex; SymTableBytes : TByteCount; SymHashTableBytes : TByteCount; AddrHashTableBytes : TByteCount; TotalUDTs : TItemCount; TotalOtherSyms : TItemCount; TotalSymbols : TItemCount; TotalNameSpaces : TItemCount; end; PCOMPILESymbolRec = ^TCOMPILESymbolRec; TCOMPILESymbolRec = record Machine : TProcessorID; Language : TLanguageID; Flags : TCompileSymbolFlags; CompilerName : PChar; end; PREGISTERSymbolRec = ^TREGISTERSymbolRec; TREGISTERSymbolRec = record TypeIndex : TTypeIndex; RegisterIndex : TRegisterIndex; NameIndex : TNameIndex; BrowserOffset : TFileOffset; end; PCONSTSymbolRec = ^TCONSTSymbolRec; TCONSTSymbolRec = record TypeIndex : TTypeIndex; NameIndex : TNameIndex; BrowserOffset : TFileOffset; Value : TConstValue; end; PUDTSymbolRec = ^TUDTSymbolRec; TUDTSymbolRec = record TypeIndex : TTypeIndex; Properties : TUDTFlags; NameIndex : TNameIndex; BrowserOffset : TFileOffset; end; PSSEARCHSymbolRec = ^TSSEARCHSymbolRec; TSSEARCHSymbolRec = record FirstProcSegment : TSegmentIndex; FirstProcOffset : TSegmentOffset; CodeSymCount : TItemCount; DataSymCount : TItemCount; FirstData : TFileOffsetDelta; end; POBJNAMESymbolRec = ^TOBJNAMESymbolRec; TOBJNAMESymbolRec = record Signature : TSignature; NameIndex : TNameIndex; end; PGPROCREFSymbolRec = ^TGPROCREFSymbolRec; TGPROCREFSymbolRec = record RefSymOffset : TFileOffset; TypeIndex : TTypeIndex; NameIndex : TNameIndex; BrowserOffset : TFileOffset; CodeSegment : TSegmentIndex; CodeOffset : TSegmentOffset; end; PGDATAREFSymbolRec = ^TGDATAREFSymbolRec; TGDATAREFSymbolRec = record RefSymOffset : TFileOffset; TypeIndex : TTypeIndex; NameIndex : TNameIndex; BrowserOffset : TFileOffset; DataSegment : TSegmentIndex; DataOffset : TSegmentOffset; end; PEDATASymbolRec = ^TEDATASymbolRec; TEDATASymbolRec = record TypeIndex : TTypeIndex; NameIndex : TNameIndex; ExternIndex : TExternIndex; Flags : TSymbolFlags; BrowserOffset : TFileOffset; end; PEPROCSymbolRec = ^TEPROCSymbolRec; TEPROCSymbolRec = record TypeIndex : TTypeIndex; NameIndex : TNameIndex; ExternIndex : TExternIndex; Flags : TSymbolFlags; BrowserOffset : TFileOffset; end; PUSESSymbolRec = ^TUSESSymbolRec; TUSESSymbolRec = record NameCount : TItemCount; NameIndices : PNameIndices; end; PNAMESPACESymbolRec = ^TNAMESPACESymbolRec; TNAMESPACESymbolRec = record UsingCount : TItemCount; NameIndex : TNameIndex; BrowserOffset : TFileOffset; UsingIndices : PNameIndices end; PUSINGSymbolRec = ^TUSINGSymbolRec; TUSINGSymbolRec = record NameCount : TItemCount; NameIndices : PNameIndices; end; PPCONSTANTSymbolRec = ^TPCONSTANTSymbolRec; TPCONSTANTSymbolRec = record TypeIndex : TTypeIndex; NameIndex : TNameIndex; Properties : TPascalConstantProperties; BrowserOffset : TFileOffset; ValueLen : TByteCount; Value : PChar; end; PBPREL32SymbolRec = ^TBPREL32SymbolRec; TBPREL32SymbolRec = record EBPOffset : TEBPOffset; TypeIndex : TTypeIndex; NameIndex : TNameIndex; BrowserOffset : TFileOffset; end; PLDATA32SymbolRec = ^TLDATA32SymbolRec; TLDATA32SymbolRec = record Offset : TSegmentOffset; Segment : TSegmentIndex; Flags : TSymbolFlags; TypeIndex : TTypeIndex; NameIndex : TNameIndex; BrowserOffset : TFileOffset; end; PGDATA32SymbolRec = ^TGDATA32SymbolRec; TGDATA32SymbolRec = record Offset : TSegmentOffset; Segment : TSegmentIndex; Flags : TSymbolFlags; TypeIndex : TTypeIndex; NameIndex : TNameIndex; BrowserOffset : TFileOffset; end; PPUB32SymbolRec = ^TPUB32SymbolRec; TPUB32SymbolRec = record Offset : TSegmentOffset; Segment : TSegmentIndex; Flags : TSymbolFlags; TypeIndex : TTypeIndex; NameIndex : TNameIndex; BrowserOffset : TFileOffset; end; PLPROC32SymbolRec = ^TLPROC32SymbolRec; TLPROC32SymbolRec = record Parent : TSubsectionDelta; End_ : TSubsectionDelta; Next : TSubsectionDelta; CodeLength : TByteCount; DebugStart : TFileOffset; DebugEnd : TFileOffset; Offset : TSegmentOffset; Segment : TSegmentIndex; Flags : DWORD; TypeIndex : TTypeIndex; NameIndex : TNameIndex; BrowserOffset : TFileOffset; end; PGPROC32SymbolRec = ^TGPROC32SymbolRec; TGPROC32SymbolRec = record Parent : TSubsectionDelta; End_ : TSubsectionDelta; Next : TSubsectionDelta; CodeLength : TByteCount; DebugStart : TFileOffset; DebugEnd : TFileOffset; Offset : TSegmentOffset; Segment : TSegmentIndex; Flags : DWORD; TypeIndex : TTypeIndex; NameIndex : TNameIndex; BrowserOffset : TFileOffset; LinkName : PChar; LinkNameLen : TByteCount end; PTHUNK32SymbolRec = ^TTHUNK32SymbolRec; TTHUNK32SymbolRec = record Parent : TSubsectionDelta; End_ : TSubsectionDelta; Next : TSubsectionDelta; Offset : TSegmentOffset; Segment : TSegmentIndex; CodeLength : TByteCount; Ordinal : TThunkOrdinal; NameIndex : TNameIndex; Delta : TByteCount; end; PBLOCK32SymbolRec = ^TBLOCK32SymbolRec; TBLOCK32SymbolRec = record Parent : TSubsectionDelta; End_ : TSubsectionDelta; CodeLength : TByteCount; Offset : TSegmentOffset; Segment : TSegmentIndex; NameIndex : TNameIndex; end; PWITH32SymbolRec = ^TWITH32SymbolRec; TWITH32SymbolRec = record Parent : TSubsectionDelta; CodeLength : TByteCount; Offset : TSegmentOffset; Segment : TSegmentIndex; Flags : DWORD; TypeIndex : TTypeIndex; NameIndex : TNameIndex; VarOffset : TByteOffset; end; PLABEL32SymbolRec = ^TLABEL32SymbolRec; TLABEL32SymbolRec = record Offset : TSegmentOffset; Segment : TSegmentIndex; NearFar : TNearFar; NameIndex : TNameIndex; end; PENTRY32SymbolRec = ^TENTRY32SymbolRec; TENTRY32SymbolRec = record Offset : TSegmentOffset; Segment : TSegmentIndex; end; POPTVAR32SymbolRec = ^TOPTVAR32SymbolRec; TOPTVAR32SymbolRec = record EntryCount : TItemCount; StartEntries : PSegmentOffsets; // or nil LengthEntries : PByteCounts; // or nil RegNameEntries : PRegNameIndices end; PPROCRET32SymbolRec = ^TPROCRET32SymbolRec; TPROCRET32SymbolRec = record Offset : TSegmentOffset; Length : TByteCount; end; PSAVREGS32SymbolRec = ^TSAVREGS32SymbolRec; TSAVREGS32SymbolRec = record Mask : TSaveRegs; EBPOffset : TEBPOffset; end; PSLINK32SymbolRec = ^TSLINK32SymbolRec; TSLINK32SymbolRec = record EBPOffset : TEBPOffset; end; PSymbolInfoRec = ^TSymbolInfoRec; TSymbolInfoRec = record Symbol : TBorDebugSymbol; case TSymbolKind of 0 : (SymbolPtr : Pointer ); BORDEBUG_S_COMPILE : (COMPILESymbol : PCOMPILESymbolRec ); BORDEBUG_S_REGISTER : (REGISTERSymbol : PREGISTERSymbolRec ); BORDEBUG_S_CONST : (CONSTSymbol : PCONSTSymbolRec ); BORDEBUG_S_UDT : (UDTSymbol : PUDTSymbolRec ); BORDEBUG_S_SSEARCH : (SSEARCHSymbol : PSSEARCHSymbolRec ); BORDEBUG_S_OBJNAME : (OBJNAMESymbol : POBJNAMESymbolRec ); BORDEBUG_S_GPROCREF : (GPROCREFSymbol : PGPROCREFSymbolRec ); BORDEBUG_S_GDATAREF : (GDATAREFSymbol : PGDATAREFSymbolRec ); BORDEBUG_S_EDATA : (EDATASymbol : PEDATASymbolRec ); BORDEBUG_S_EPROC : (EPROCSymbol : PEPROCSymbolRec ); BORDEBUG_S_USES : (USESSymbol : PUSESSymbolRec ); BORDEBUG_S_NAMESPACE : (NAMESPACESymbol: PNAMESPACESymbolRec); BORDEBUG_S_USING : (USINGSymbol : PUSINGSymbolRec ); BORDEBUG_S_PCONSTANT : (PCONSTANTSymbol: PPCONSTANTSymbolRec); BORDEBUG_S_BPREL32 : (BPREL32Symbol : PBPREL32SymbolRec ); BORDEBUG_S_LDATA32 : (LDATA32Symbol : PLDATA32SymbolRec ); BORDEBUG_S_GDATA32 : (GDATA32Symbol : PGDATA32SymbolRec ); BORDEBUG_S_PUB32 : (PUB32Symbol : PPUB32SymbolRec ); BORDEBUG_S_LPROC32 : (LPROC32Symbol : PLPROC32SymbolRec ); BORDEBUG_S_GPROC32 : (GPROC32Symbol : PGPROC32SymbolRec ); BORDEBUG_S_THUNK32 : (THUNK32Symbol : PTHUNK32SymbolRec ); BORDEBUG_S_BLOCK32 : (BLOCK32Symbol : PBLOCK32SymbolRec ); BORDEBUG_S_WITH32 : (WITH32Symbol : PWITH32SymbolRec ); BORDEBUG_S_LABEL32 : (LABEL32Symbol : PLABEL32SymbolRec ); BORDEBUG_S_ENTRY32 : (ENTRY32Symbol : PENTRY32SymbolRec ); BORDEBUG_S_OPTVAR32 : (OPTVAR32Symbol : POPTVAR32SymbolRec ); BORDEBUG_S_PROCRET32 : (PROCRET32Symbol: PPROCRET32SymbolRec); BORDEBUG_S_SAVREGS32 : (SAVREGS32Symbol: PSAVREGS32SymbolRec); BORDEBUG_S_SLINK32 : (SLINK32Symbol : PSLINK32SymbolRec ); end; PMODIFIERTypeRec = ^TMODIFIERTypeRec; TMODIFIERTypeRec = record Attributes : TTypeModifierAttr; TypeIndex : TTypeIndex; end; PPOINTERTypeRec = ^TPOINTERTypeRec; TPOINTERTypeRec = record Attributes : TTypePointerAttr; TypeIndex : TTypeIndex; Value1 : TTypePointerValue1; Value2 : TTypePointerValue2; end; PARRAYTypeRec = ^TARRAYTypeRec; TARRAYTypeRec = record ElementType : TTypeIndex; IndexType : TTypeIndex; NameIndex : TNameIndex; Size : TByteCount; Elements : TItemCount; end; PCLASSTypeRec = ^TCLASSTypeRec; TCLASSTypeRec = record FieldCount : TItemCount; FieldList : TTypeIndex; ClassFlags : TClassFlags; ContainingClass : TTypeIndex; DerivationList : TTypeIndex; Vtable : TTypeIndex; NameIndex : TNameIndex; ClassSize : TByteCount; end; PUNIONTypeRec = ^TUNIONTypeRec; TUNIONTypeRec = record FieldCount : TItemCount; FieldList : TTypeIndex; ClassFlags : TClassFlags; ContainingClass : TTypeIndex; NameIndex : TNameIndex; ClassSize : TByteCount; end; PENUMTypeRec = ^TENUMTypeRec; TENUMTypeRec = record MemberCount : TItemCount; UnderlyingType : TTypeIndex; MemberList : TTypeIndex; ContainingClass : TTypeIndex; NameIndex : TNameIndex; end; PPROCEDURETypeRec = ^TPROCEDURETypeRec; TPROCEDURETypeRec = record ReturnType : TTypeIndex; CallingConvention : TCallingConvention; ArgCount : TItemCount; ArgList : TTypeIndex; end; PMFUNCTIONTypeRec = ^TMFUNCTIONTypeRec; TMFUNCTIONTypeRec = record ReturnType : TTypeIndex; ClassType : TTypeIndex; ThisType : TTypeIndex; CallingConvention : TCallingConvention; ArgCount : TItemCount; ArgList : TTypeIndex; ThisAdjust : TSegmentOffset {?}; end; PVTSHAPETypeRec = ^TVTSHAPETypeRec; TVTSHAPETypeRec = record DescriptorCount : TItemCount; DescriptorArray : PVtblShapeDescriptors end; PLABELTypeRec = ^TLABELTypeRec; TLABELTypeRec = record NearFar : TNearFar; end; PSETTypeRec = ^TSETTypeRec; TSETTypeRec = record ElemType : TTypeIndex; NameIndex : TNameIndex; LowByte : DWORD; Length : TItemCount; end; PSUBRANGETypeRec = ^TSUBRANGETypeRec; TSUBRANGETypeRec = record BaseType : TTypeIndex; NameIndex : TNameIndex; LoBound : DWORD; HiBound : DWORD; Size : TByteCount; end; PPARRAYTypeRec = ^TPARRAYTypeRec; TPARRAYTypeRec = record ElementType : TTypeIndex; IndexType : TTypeIndex; NameIndex : TNameIndex; Size : TByteCount; Elements : TItemCount; end; PPSTRINGTypeRec = ^TPSTRINGTypeRec; TPSTRINGTypeRec = record ElemType : TTypeIndex; IndexType : TTypeIndex; NameIndex : TNameIndex; end; PCLOSURETypeRec = ^TCLOSURETypeRec; TCLOSURETypeRec = record ReturnType : TTypeIndex; CallingConvention : TCallingConvention; ArgCount : TItemCount; ArgList : TTypeIndex; end; PPROPERTYTypeRec = ^TPROPERTYTypeRec; TPROPERTYTypeRec = record TypeIndex : TTypeIndex; Flags : TPropertyFlags; ArrayIndex : TTypeIndex; PropIndex : TPropertyIndex; ReadSlot : TPropertySlot; WriteSlot : TPropertySlot; end; PLSTRINGTypeRec = ^TLSTRINGTypeRec; TLSTRINGTypeRec = record NameIndex : TNameIndex; end; PVARIANTTypeRec = ^TVARIANTTypeRec; TVARIANTTypeRec = record NameIndex : TNameIndex; end; PCLASSREFTypeRec = ^TCLASSREFTypeRec; TCLASSREFTypeRec = record RefType : TTypeIndex; VtShape : TTypeIndex; end; PWSTRINGTypeRec = ^TWSTRINGTypeRec; TWSTRINGTypeRec = record NameIndex : TNameIndex; end; PARGLISTTypeRec = ^TARGLISTTypeRec; TARGLISTTypeRec = record TypeCount : TItemCount; TypeArray : PTypeIndices end; PDERIVEDTypeRec = ^TDERIVEDTypeRec; TDERIVEDTypeRec = record TypeCount : TItemCount; DerivedTypes : PTypeIndices end; PBITFIELDTypeRec = ^TBITFIELDTypeRec; TBITFIELDTypeRec = record Length : TBitCount; Position : TBitPosition; TypeIndex : TTypeIndex; end; PMETHODLISTTypeRec = ^TMETHODLISTTypeRec; TMETHODLISTTypeRec = record MethodCount : TItemCount; TypeArray : PTypeIndices; AttribArray : PClassMemberAttribs; BrowserArray : PFileOffsets; VtabOffArray : PVtabOffsets end; PBCLASSTypeRec = ^TBCLASSTypeRec; TBCLASSTypeRec = record BaseType : TTypeIndex; Attrib : TClassMemberAttrib; Offset : TVtabOffset; end; PVBCLASSTypeRec = ^TVBCLASSTypeRec; TVBCLASSTypeRec = record vbType : TTypeIndex; vbpType : TTypeIndex; Attrib : TClassMemberAttrib; VbpOffset : TVtabOffset; Offset : TVtabOffset; end; PIVBCLASSTypeRec = ^TIVBCLASSTypeRec; TIVBCLASSTypeRec = record vbType : TTypeIndex; vbpType : TTypeIndex; Attrib : TClassMemberAttrib; VbpOffset : TVtabOffset; Offset : TVtabOffset; end; PENUMERATETypeRec = ^TENUMERATETypeRec; TENUMERATETypeRec = record Attrib : DWORD; NameIndex : TNameIndex; BrowserOffset : TFileOffset; Value : DWORD; end; PFRIENDFCNTypeRec = ^TFRIENDFCNTypeRec; TFRIENDFCNTypeRec = record TypeIndex : TTypeIndex; NameIndex : TNameIndex; end; PINDEXTypeRec = ^TINDEXTypeRec; TINDEXTypeRec = record TypeIndex : TTypeIndex; end; PMEMBERTypeRec = ^TMEMBERTypeRec; TMEMBERTypeRec = record TypeIndex : TTypeIndex; Attrib : TClassMemberAttrib; NameIndex : TNameIndex; Offset : TInstanceOffset; BrowserOffset : TFileOffset; end; PSTMEMBERTypeRec = ^TSTMEMBERTypeRec; TSTMEMBERTypeRec = record TypeIndex : TTypeIndex; Attrib : TClassMemberAttrib; NameIndex : TNameIndex; BrowserOffset : TFileOffset; end; PMETHODTypeRec = ^TMETHODTypeRec; TMETHODTypeRec = record OverloadedCount : TItemCount; MethodList : TTypeIndex; NameIndex : TNameIndex; end; PNESTTYPETypeRec = ^TNESTTYPETypeRec; TNESTTYPETypeRec = record TypeIndex : TTypeIndex; NameIndex : TNameIndex; BrowserOffset : TFileOffset; end; PVFUNCTABTypeRec = ^TVFUNCTABTypeRec; TVFUNCTABTypeRec = record TypeIndex : TTypeIndex; Offset : TVtabOffset; end; PFRIENDCLSTypeRec = ^TFRIENDCLSTypeRec; TFRIENDCLSTypeRec = record TypeIndex : TTypeIndex; end; PCHARTypeRec = ^TCHARTypeRec; TCHARTypeRec = record Value : Char; end; PSHORTTypeRec = ^TSHORTTypeRec; TSHORTTypeRec = record Value : SmallInt; end; PUSHORTTypeRec = ^TUSHORTTypeRec; TUSHORTTypeRec = record Value : DWORD; end; PLONGTypeRec = ^TLONGTypeRec; TLONGTypeRec = record Value : LongInt; end; PULONGTypeRec = ^TULONGTypeRec; TULONGTypeRec = record Value : DWORD; end; PREAL32TypeRec = ^TREAL32TypeRec; TREAL32TypeRec = record Value : Single; end; PREAL64TypeRec = ^TREAL64TypeRec; TREAL64TypeRec = record Value : Double; end; PREAL80TypeRec = ^TREAL80TypeRec; TREAL80TypeRec = record Value : Extended; end; PQUADWORDTypeRec = ^TQUADWORDTypeRec; TQUADWORDTypeRec = record Value : QUADWORD; end; PUQUADWORDTypeRec = ^TUQUADWORDTypeRec; TUQUADWORDTypeRec = record Value : UQUADWORD; end; PREAL48TypeRec = ^TREAL48TypeRec; TREAL48TypeRec = record Value : TREAL48; end; PTypeInfoRec = ^TTypeInfoRec; TTypeInfoRec = record BDType : TBorDebugType; case TTypeKind of 0 : (TypePtr : Pointer); BORDEBUG_LF_MODIFIER : (MODIFIERType : PMODIFIERTypeRec); BORDEBUG_LF_POINTER : (POINTERType : PPOINTERTypeRec); BORDEBUG_LF_ARRAY : (ARRAYType : PARRAYTypeRec); BORDEBUG_LF_STRUCT, BORDEBUG_LF_CLASS : (CLASSType : PCLASSTypeRec); BORDEBUG_LF_UNION : (UNIONType : PUNIONTypeRec); BORDEBUG_LF_ENUM : (ENUMType : PENUMTypeRec); BORDEBUG_LF_PROCEDURE : (PROCEDUREType : PPROCEDURETypeRec); BORDEBUG_LF_MFUNCTION : (MFUNCTIONType : PMFUNCTIONTypeRec); BORDEBUG_LF_VTSHAPE : (VTSHAPEType : PVTSHAPETypeRec); BORDEBUG_LF_LABEL : (LABELType : PLABELTypeRec); BORDEBUG_LF_SET : (SETType : PSETTypeRec); BORDEBUG_LF_SUBRANGE : (SUBRANGEType : PSUBRANGETypeRec); BORDEBUG_LF_PARRAY : (PARRAYType : PPARRAYTypeRec); BORDEBUG_LF_PSTRING : (PSTRINGType : PPSTRINGTypeRec); BORDEBUG_LF_CLOSURE : (CLOSUREType : PCLOSURETypeRec); BORDEBUG_LF_PROPERTY : (PROPERTYType : PPROPERTYTypeRec); BORDEBUG_LF_LSTRING : (LSTRINGType : PLSTRINGTypeRec); BORDEBUG_LF_VARIANT : (VARIANTType : PVARIANTTypeRec); BORDEBUG_LF_CLASSREF : (CLASSREFType : PCLASSREFTypeRec); BORDEBUG_LF_WSTRING : (WSTRINGType : PWSTRINGTypeRec); BORDEBUG_LF_ARGLIST : (ARGLISTType : PARGLISTTypeRec); BORDEBUG_LF_DERIVED : (DERIVEDType : PDERIVEDTypeRec); BORDEBUG_LF_BITFIELD : (BITFIELDType : PBITFIELDTypeRec); BORDEBUG_LF_METHODLIST : (METHODLISTType : PMETHODLISTTypeRec); BORDEBUG_LF_BCLASS : (BCLASSType : PBCLASSTypeRec); BORDEBUG_LF_VBCLASS : (VBCLASSType : PVBCLASSTypeRec); BORDEBUG_LF_IVBCLASS : (IVBCLASSType : PIVBCLASSTypeRec); BORDEBUG_LF_ENUMERATE : (ENUMERATEType : PENUMERATETypeRec); BORDEBUG_LF_FRIENDFCN : (FRIENDFCNType : PFRIENDFCNTypeRec); BORDEBUG_LF_INDEX : (INDEXTypeR : PINDEXTypeRec); BORDEBUG_LF_MEMBER : (MEMBERType : PMEMBERTypeRec); BORDEBUG_LF_STMEMBER : (STMEMBERType : PSTMEMBERTypeRec); BORDEBUG_LF_METHOD : (METHODType : PMETHODTypeRec); BORDEBUG_LF_NESTTYPE : (NESTTYPEType : PNESTTYPETypeRec); BORDEBUG_LF_VFUNCTAB : (VFUNCTABType : PVFUNCTABTypeRec); BORDEBUG_LF_FRIENDCLS : (FRIENDCLSType : PFRIENDCLSTypeRec); BORDEBUG_LF_CHAR : (CHARType : PCHARTypeRec); BORDEBUG_LF_SHORT : (SHORTType : PSHORTTypeRec); BORDEBUG_LF_USHORT : (USHORTType : PUSHORTTypeRec); BORDEBUG_LF_LONG : (LONGType : PLONGTypeRec); BORDEBUG_LF_ULONG : (ULONGType : PULONGTypeRec); BORDEBUG_LF_REAL32 : (REAL32Type : PREAL32TypeRec); BORDEBUG_LF_REAL64 : (REAL64Type : PREAL64TypeRec); BORDEBUG_LF_REAL80 : (REAL80Type : PREAL80TypeRec); BORDEBUG_LF_QUADWORD : (QUADWORDType : PQUADWORDTypeRec); BORDEBUG_LF_UQUADWORD : (UQUADWORDType : PUQUADWORDTypeRec); BORDEBUG_LF_REAL48 : (REAL48Type : PREAL48TypeRec); end; // Forward class declarations: TModuleSegment = class; TSourceFileEntry = class; TLineNumberOffsets = class; TBorDebugModule = class; TBorDebugSrcModule = class; TSymbolInfo = class; TTypeInfo = class; // TBorDebug: This is the main root class responsible for opening the EXE // file and giving a simplified interface to the debug information provided // by the BorDebug API TBorDebug = class(TObject) private // Surfaced through properties: FHandle: TBorDebHandle; FFileName: string; FSkipNames: boolean; FCacheNames: boolean; FSubSectionCount: TItemCount; FNameCount: TItemCount; FTypeCount: TItemCount; FTypesSignature: TSignature; FSubSectionDirectoryOffset: TFileOffset; function GetHandle: TBorDebHandle; procedure SetFileName(const Value: string); function GetActive: boolean; procedure SetActive(Value: boolean); function GetNames(Index: TNameIndex): string; function GetUnmangledNames(Index: TNameIndex): string; function GetRegisterName(RegIndex: TRegNameIndex): string; function GetSubSections(Index: TSubSectionIndex): TBorDebugSubSection; function GetTypeFromIndex(TypeIndex: TTypeIndex): TBorDebugType; function GetTypeFromOffset(Offset: TFileOffset): TBorDebugType; function GetTypeName(TypeIndex: TTypeIndex): string; function GetGlobalSymbols(const SubSection: TBorDebugSubSection): TBorDebugGlobalSymbol; protected // Possible add default loop here with overrideable/events for reporting...? public constructor Create(const aFilename: string = ''); destructor Destroy; override; procedure Open; procedure Close; property Handle: TBorDebHandle read GetHandle; // FileName must be set to the EXE/DLL/DPL/BPL/OCX... file property FileName: string read FFileName write SetFileName; property SkipNames: boolean read FSkipNames write FSkipNames default False; property CacheNames: boolean read FCacheNames write FCacheNames default True; // Active := True/False is the same as Open/Close property Active: boolean read GetActive write SetActive; // Use 1..NameCount as index. NOTE: 1-based! property NameCount: TItemCount read FNameCount; property Names[Index: TNameIndex]: string read GetNames; property UnmangledNames[Index: TNameIndex]: string read GetUnmangledNames; // The RegIndex comes from BorDebugSymbolOPTVAR32 property RegisterName[RegIndex: TRegNameIndex]: string read GetRegisterName; // Use 0..SubSectionCount-1 as index property SubSectionCount: TItemCount read FSubSectionCount; property SubSections[Index: TSubSectionIndex]: TBorDebugSubSection read GetSubSections; // Use SubSections[X] as index when SubSections[X].SubsectionType = BORDEBUG_SSTMODULE function CreateModule(const SubSection: TBorDebugSubSection): TBorDebugModule; // Use SubSections[X] as index when SubSections[X].SubsectionType = BORDEBUG_SSTSRCMODULE function CreateSrcModule(const SubSection: TBorDebugSubSection ): TBorDebugSrcModule; // Call this pair when SubSections[X].SubsectionType = // BORDEBUG_SSTALIGNSYM, BORDEBUG_SSTGLOBALSYM or BORDEBUG_SSTGLOBALPUB procedure StartSymbols(const SubSection: TBorDebugSubSection); function GetNextSymbol(var Symbol: TBorDebugSymbol): boolean; function CreateSymbolInfo(const Symbol: TBorDebugSymbol): TSymbolInfo; function CreateTypeInfo(const aType: TBorDebugType): TTypeInfo; property TypeFromIndex[TypeIndex: TTypeIndex]: TBorDebugType read GetTypeFromIndex; property TypeFromOffset[Offset: TFileOffset]: TBorDebugType read GetTypeFromOffset; property TypeName[TypeIndex: TTypeIndex]: string read GetTypeName; // Use SubSections[X] as index when SubSections[X].SubsectionType = // BORDEBUG_SSTGLOBALSYM or BORDEBUG_SSTGLOBALPUB property GlobalSymbols[const SubSection: TBorDebugSubSection]: TBorDebugGlobalSymbol read GetGlobalSymbols; property TypeCount: TItemCount read FTypeCount; property TypesSignature: TSignature read FTypesSignature; property SubSectionDirectoryOffset: TFileOffset read FSubSectionDirectoryOffset; end; // TBorDebugObject contains the common properties of TBorDebugModule and // TBorDebugSrcModule TBorDebugObject = class(TObject) private FBorDebug : TBorDebug; FOffset : TFileOffset; function GetHandle: TBorDebHandle; public constructor Create(BorDebug: TBorDebug; Offset: TFileOffset); destructor Destroy; override; property BorDebug : TBorDebug read FBorDebug; property Handle : TBorDebHandle read GetHandle; property Offset : TFileOffset read FOffset; end; // TBorDebugModule represents a unit of code that has been linked // into the executable. All units end up here even if it there // is no source code (DCU only). TBorDebugModule = class(TBorDebugObject) private FOverlay : TOverlayIndex; FLibIndex : TLibraryIndex; FStyle : TDebuggingStyle; FNameIndex : TNameIndex; FTimeStamp : TBDTimeStamp; FSegmentCount : TItemCount; FModuleSegmentList : TList; // of TModuleSegment function GetName: string; function GetSegments(Index: integer): TModuleSegment; public constructor Create(BorDebug: TBorDebug; Offset: TFileOffset); destructor Destroy; override; property Overlay : TOverlayIndex read FOverlay; property LibIndex : TLibraryIndex read FLibIndex; property Style : TDebuggingStyle read FStyle; property TimeStamp : TBDTimeStamp read FTimeStamp; property SegmentCount : TItemCount read FSegmentCount; property NameIndex : TNameIndex read FNameIndex; property Name : string read GetName; // Index list with 0..SegmentCount-1 property ModuleSegmentList : TList read FModuleSegmentList; property Segments[Index: integer]: TModuleSegment read GetSegments; end; // SrcModule = Pascal Unit. // Should we rename it TBorDebugSrcUnit or TBorDebugUnit?? TBorDebugSrcModule = class(TBorDebugObject) private FRangeCount : TItemCount; FRangeSegments : PSegmentIndices; FRangeSegmentStarts : PSegmentOffsets; FRangeSegmentEnds : PSegmentOffsets; FSourceCount : TItemCount; FSourceOffsets : PFileOffsets; FNameIndices : PNameIndices; FRangeCounts : PItemCounts; FSourceFileList : TList; // of TSourceFileEntry function GetSources(Index: integer): TSourceFileEntry; function GetSourceNames(Index: integer): string; public constructor Create(BorDebug: TBorDebug; Offset: TFileOffset); destructor Destroy; override; // Index arrays with 0..RangeCount-1 property RangeCount : TItemCount read FRangeCount; property RangeSegments : PSegmentIndices read FRangeSegments; property RangeSegmentStarts : PSegmentOffsets read FRangeSegmentStarts; property RangeSegmentEnds : PSegmentOffsets read FRangeSegmentEnds; // Index arrays with 0..SourceCount-1 property SourceCount : TItemCount read FSourceCount; property SourceOffsets : PFileOffsets read FSourceOffsets; property NameIndices : PNameIndices read FNameIndices; property RangeCounts : PItemCounts read FRangeCounts; // Index list with 0..SourceCount-1 property SourceFileList : TList read FSourceFileList; property SourceFiles[Index: integer]: TSourceFileEntry read GetSources; property SourceNames[Index: integer]: string read GetSourceNames; end; TModuleSegment = class(TObject) private FLinkerSegment : TLinkerSegmentIndex; FOffset : TFileOffset; FSize : TByteCount; FFlags : TSegmentFlags; public constructor Create(Module : TBorDebugModule; SegmentIndex : TSegmentIndex); property LinkerSegment : TLinkerSegmentIndex read FLinkerSegment; property Offset : TFileOffset read FOffset; property Size : TByteCount read FSize; property Flags : TSegmentFlags read FFlags; end; TSourceFileEntry = class(TObject) private FSrcModule : TBorDebugSrcModule; FSourceFileIndex : TSourceFileIndex; FRangeSegments : PSegmentIndices; FRangeSegmentStarts : PSegmentOffsets; FRangeSegmentEnds : PSegmentOffsets; FLineNumberCounts : PItemCounts; FLineNumerOffsetList : TList; // of TLineNumberOffsets function GetRangeLineNumbers(Index: integer): TLineNumberOffsets; function GetName: string; function GetBorDebug: TBorDebug; function GetHandle: TBorDebHandle; function GetNameIndex: TNameIndex; function GetOffset: TFileOffset; function GetRangeCount: TItemCount; public constructor Create(SrcModule : TBorDebugSrcModule; SourceFileIndex : TSourceFileIndex); destructor Destroy; override; property BorDebug : TBorDebug read GetBorDebug; property Handle : TBorDebHandle read GetHandle; property Offset : TFileOffset read GetOffset; property SrcModule : TBorDebugSrcModule read FSrcModule; property Name : string read GetName; property NameIndex : TNameIndex read GetNameIndex; property SourceFileIndex : TSourceFileIndex read FSourceFileIndex; property RangeSegments : PSegmentIndices read FRangeSegments; property RangeSegmentStarts : PSegmentOffsets read FRangeSegmentStarts; property RangeSegmentEnds : PSegmentOffsets read FRangeSegmentEnds; property LineNumberCounts : PItemCounts read FLineNumberCounts; property LineNumerOffsetList: TList read FLineNumerOffsetList; property RangeCount : TItemCount read GetRangeCount; property RangeLineNumbers[Index: integer]: TLineNumberOffsets read GetRangeLineNumbers; end; TLineNumberOffsets = class(TObject) private FSourceFile : TSourceFileEntry; FLineNumbers : PLineNumbers; FLineOffsets : PSegmentOffsets; FRangeIndex : TRangeIndex; function GetLineCount: TItemCount; public constructor Create(SourceFile : TSourceFileEntry; RangeIndex : TRangeIndex); destructor Destroy; override; property SourceFile : TSourceFileEntry read FSourceFile; property LineNumbers : PLineNumbers read FLineNumbers; property LineOffsets : PSegmentOffsets read FLineOffsets; property LineCount : TItemCount read GetLineCount; property RangeIndex : TRangeIndex read FRangeIndex; end; TSymbolInfo = class(TObject) private FInfoRec: TSymbolInfoRec; function GetKindAsString: string; public constructor Create(BorDebug: TBorDebug; Symbol: TBorDebugSymbol); destructor Destroy; override; function GetTypeIndex(var TypeIndex: TTypeIndex): boolean; function GetNameIndex(var NameIndex: TNameIndex): boolean; property Symbol : TBorDebugSymbol read FInfoRec.Symbol; property SymbolOffset : TFileOffset read FInfoRec.Symbol.Offset; property Len : TByteCount read FInfoRec.Symbol.Len; property Kind : TSymbolKind read FInfoRec.Symbol.Kind; property Info : TSymbolInfoRec read FInfoRec; property KindAsString : string read GetKindAsString; end; TTypeInfo = class(TObject) private FInfoRec: TTypeInfoRec; function GetNameIndex: TNameIndex; function GetKindAsString: string; public constructor Create(BorDebug: TBorDebug; aType: TBorDebugType); destructor Destroy; override; property BDType : TBorDebugType read FInfoRec.BDType; property TypeIndex : TTypeIndex read FInfoRec.BDType.TypeIndex; property TypeOffset : TFileOffset read FInfoRec.BDType.TypeOffset; property Length : TByteCount read FInfoRec.BDType.Length; property TypeKind : TTypeKind read FInfoRec.BDType.TypeKind; property Info : TTypeInfoRec read FInfoRec; property NameIndex : TNameIndex read GetNameIndex; property KindAsString : string read GetKindAsString; end; { Utility routines } procedure FreeObject(var Instance); procedure FreePtr(var Ptr); procedure FreeTList(var List: TList); function SymbolKindToString(SymbolKind: TSymbolKind): string; function SaveRegsToString(SaveRegs: TSaveRegs): string; function TypeKindToString(TypeKind: TTypeKind): string; function SubsectionTypeToString(SubsectionType: TSubsectionType): string; function ClassFlagsToString(ClassFlags: TClassFlags): string; function CallingConventionToString(CallingConvention: TCallingConvention): string; function PropertyFlagsToString(PropertyFlags: TPropertyFlags): string; function ClassMemberAttribToString(ClassMemberAttrib: TClassMemberAttrib): string; implementation { Utility routines } resourcestring SIndexOutOfRange = 'Index %d out of valid range 0..%d'; SUnexpectedSection = 'Unexpected subsection type here: %s'; procedure CheckIndex(Index, Count: integer); begin if (Index < 0) or (Index >= Count) then raise HVBorDebugIndexError.CreateFmt(SIndexOutOfRange, [Index, Count-1]); end; procedure CheckSection(SubsectionType: TSubsectionType; ValidSubSections: array of TSubsectionType); var i : integer; begin for i:= Low(ValidSubSections) to High(ValidSubSections) do if SubsectionType = ValidSubSections[i] then Exit; raise HVBorDebugSectionError.CreateFmt(SUnexpectedSection, [SubSectionTypeToString(SubsectionType)]); end; procedure FreeObject(var Instance); var Tmp: TObject; begin Tmp := TObject(Instance); TObject(Instance) := nil; Tmp.Free; end; procedure FreePtr(var Ptr); begin FreeMem(Pointer(Ptr)); Pointer(Ptr) := nil; end; procedure FreeTList(var List: TList); var i : integer; begin for i := 0 to List.Count-1 do FreeObject(List.List^[i]); FreeObject(List); end; function SaveRegsToString(SaveRegs: TSaveRegs): string; begin Result := ''; if srEBX in SaveRegs then Result := Result + 'EBX, '; if srEDI in SaveRegs then Result := Result + 'EDI, '; if srESI in SaveRegs then Result := Result + 'ESI, '; if srEBP in SaveRegs then Result := Result + 'EBP, '; if Result <> '' then begin Delete(Result, Length(Result)-1, 2); Result := '[' + Result + ']'; end; end; function SymbolKindToString(SymbolKind: TSymbolKind): string; begin case SymbolKind of BORDEBUG_S_COMPILE : Result := 'COMPILE'; BORDEBUG_S_REGISTER : Result := 'REGISTER'; BORDEBUG_S_CONST : Result := 'CONST'; BORDEBUG_S_UDT : Result := 'UDT'; BORDEBUG_S_SSEARCH : Result := 'SSEARCH'; BORDEBUG_S_END : Result := 'END'; BORDEBUG_S_SKIP : Result := 'SKIP'; BORDEBUG_S_CVRESERVE : Result := 'CVRESERVE' ; BORDEBUG_S_OBJNAME : Result := 'OBJNAME'; BORDEBUG_S_GPROCREF : Result := 'GPROCREF'; BORDEBUG_S_GDATAREF : Result := 'GDATAREF'; BORDEBUG_S_EDATA : Result := 'EDATA'; BORDEBUG_S_EPROC : Result := 'EPROC'; BORDEBUG_S_USES : Result := 'USES'; BORDEBUG_S_NAMESPACE : Result := 'NAMESPACE' ; BORDEBUG_S_USING : Result := 'USING'; BORDEBUG_S_PCONSTANT : Result := 'PCONSTANT' ; BORDEBUG_S_BPREL32 : Result := 'BPREL'; BORDEBUG_S_LDATA32 : Result := 'LDATA'; BORDEBUG_S_GDATA32 : Result := 'GDATA'; BORDEBUG_S_PUB32 : Result := 'PUB'; BORDEBUG_S_LPROC32 : Result := 'LPROC'; BORDEBUG_S_GPROC32 : Result := 'GPROC'; BORDEBUG_S_THUNK32 : Result := 'THUNK'; BORDEBUG_S_BLOCK32 : Result := 'BLOCK'; BORDEBUG_S_WITH32 : Result := 'WITH'; BORDEBUG_S_LABEL32 : Result := 'LABEL'; BORDEBUG_S_CEXMODEL32 : Result := 'CEXMODEL' ; BORDEBUG_S_VFTPATH32 : Result := 'VFTPATH' ; BORDEBUG_S_ENTRY32 : Result := 'ENTRY'; BORDEBUG_S_OPTVAR32 : Result := 'OPTVAR'; BORDEBUG_S_PROCRET32 : Result := 'PROCRET' ; BORDEBUG_S_SAVREGS32 : Result := 'SAVREGS' ; BORDEBUG_S_SLINK32 : Result := 'SLINK'; BORDEBUG_S_INVALID : Result := 'INVALID'; else Result := Format('<Unknown SymbolKind = %.8x)', [Ord(SymbolKind)]); end; end; function TypeKindToString(TypeKind: TTypeKind): string; begin case TypeKind of BORDEBUG_LF_STARTYP : Result := 'STARTYP'; BORDEBUG_LF_MODIFIER : Result := 'MODIFIER'; BORDEBUG_LF_POINTER : Result := 'POINTER'; BORDEBUG_LF_ARRAY : Result := 'ARRAY'; BORDEBUG_LF_CLASS : Result := 'CLASS'; BORDEBUG_LF_STRUCT : Result := 'STRUCT'; BORDEBUG_LF_UNION : Result := 'UNION'; BORDEBUG_LF_ENUM : Result := 'ENUM'; BORDEBUG_LF_PROCEDURE : Result := 'PROCEDURE'; BORDEBUG_LF_MFUNCTION : Result := 'MFUNCTION'; BORDEBUG_LF_VTSHAPE : Result := 'VTSHAPE'; BORDEBUG_LF_COBOL0 : Result := 'COBOL0'; BORDEBUG_LF_COBOL1 : Result := 'COBOL1'; BORDEBUG_LF_BARRAY : Result := 'BARRAY'; BORDEBUG_LF_LABEL : Result := 'LABEL'; BORDEBUG_LF_NULL : Result := 'NULL'; BORDEBUG_LF_NOTTRANS : Result := 'NOTTRANS'; BORDEBUG_LF_DIMARRAY : Result := 'DIMARRAY'; BORDEBUG_LF_VFTPATH : Result := 'VFTPATH'; BORDEBUG_LF_SET : Result := 'SET'; BORDEBUG_LF_SUBRANGE : Result := 'SUBRANGE'; BORDEBUG_LF_PARRAY : Result := 'PARRAY'; BORDEBUG_LF_PSTRING : Result := 'PSTRING'; BORDEBUG_LF_CLOSURE : Result := 'CLOSURE'; BORDEBUG_LF_PROPERTY : Result := 'PROPERTY'; BORDEBUG_LF_LSTRING : Result := 'LSTRING'; BORDEBUG_LF_VARIANT : Result := 'VARIANT'; BORDEBUG_LF_CLASSREF : Result := 'CLASSREF'; BORDEBUG_LF_WSTRING : Result := 'WSTRING'; BORDEBUG_LF_UNKNOWN : Result := 'UNKNOWN'; BORDEBUG_LF_INVALID_0 : Result := 'INVALID_0'; BORDEBUG_LF_SKIP : Result := 'SKIP'; BORDEBUG_LF_ARGLIST : Result := 'ARGLIST'; BORDEBUG_LF_DEFARG : Result := 'DEFARG'; BORDEBUG_LF_LIST : Result := 'LIST'; BORDEBUG_LF_FIELDLIST : Result := 'FIELDLIST'; BORDEBUG_LF_DERIVED : Result := 'DERIVED'; BORDEBUG_LF_BITFIELD : Result := 'BITFIELD'; BORDEBUG_LF_METHODLIST : Result := 'METHODLIST'; BORDEBUG_LF_DIMCONU : Result := 'DIMCONU'; BORDEBUG_LF_DIMCONLU : Result := 'DIMCONLU'; BORDEBUG_LF_DIMVARU : Result := 'DIMVARU'; BORDEBUG_LF_DIMVARLU : Result := 'DIMVARLU'; BORDEBUG_LF_REFSYM : Result := 'REFSYM'; BORDEBUG_LF_INVALID_2 : Result := 'INVALID_2'; BORDEBUG_LF_BCLASS : Result := 'BCLASS'; BORDEBUG_LF_VBCLASS : Result := 'VBCLASS'; BORDEBUG_LF_IVBCLASS : Result := 'IVBCLASS'; BORDEBUG_LF_ENUMERATE : Result := 'ENUMERATE'; BORDEBUG_LF_FRIENDFCN : Result := 'FRIENDFCN'; BORDEBUG_LF_INDEX : Result := 'INDEX'; BORDEBUG_LF_MEMBER : Result := 'MEMBER'; BORDEBUG_LF_STMEMBER : Result := 'STMEMBER'; BORDEBUG_LF_METHOD : Result := 'METHOD'; BORDEBUG_LF_NESTTYPE : Result := 'NESTTYPE'; BORDEBUG_LF_VFUNCTAB : Result := 'VFUNCTAB'; BORDEBUG_LF_FRIENDCLS : Result := 'FRIENDCLS'; BORDEBUG_LF_INVALID_4 : Result := 'INVALID_4'; BORDEBUG_LF_CHAR : Result := 'CHAR'; BORDEBUG_LF_SHORT : Result := 'SHORT'; BORDEBUG_LF_USHORT : Result := 'USHORT'; BORDEBUG_LF_LONG : Result := 'LONG'; BORDEBUG_LF_ULONG : Result := 'ULONG'; BORDEBUG_LF_REAL32 : Result := 'REAL32'; BORDEBUG_LF_REAL64 : Result := 'REAL64'; BORDEBUG_LF_REAL80 : Result := 'REAL80'; BORDEBUG_LF_REAL128 : Result := 'REAL128'; BORDEBUG_LF_QUADWORD : Result := 'QUADWORD'; BORDEBUG_LF_UQUADWORD : Result := 'UQUADWORD'; BORDEBUG_LF_REAL48 : Result := 'REAL48'; BORDEBUG_LF_INVALID_8 : Result := 'INVALID_8'; BORDEBUG_LF_RAWBITS : Result := 'RAWBITS'; BORDEBUG_LF_INVALID_9 : Result := 'INVALID_9'; else Result := Format('<Unknown TypeKind = %.8x)', [Ord(TypeKind)]); end; end; function SubsectionTypeToString(SubsectionType: TSubsectionType): string; begin case SubsectionType of BORDEBUG_SSTMODULE : Result := 'MODULE'; BORDEBUG_SSTALIGNSYM : Result := 'ALIGNSYM'; BORDEBUG_SSTSRCMODULE : Result := 'SRCMODULE'; BORDEBUG_SSTGLOBALSYM : Result := 'GLOBALSYM'; BORDEBUG_SSTGLOBALPUB : Result := 'GLOBALPUB'; BORDEBUG_SSTGLOBALTYPES : Result := 'GLOBALTYPES'; BORDEBUG_SSTNAMES : Result := 'NAMES'; BORDEBUG_SSTBROWSE : Result := 'BROWSE'; BORDEBUG_SSTINVALID : Result := 'INVALID'; else Result := Format('<Unknown SubSectionType = %.8x)', [Ord(SubSectionType)]); end; end; function ClassFlagsToString(ClassFlags: TClassFlags): string; var ClassFlag: TClassFlag; begin Result := ''; for ClassFlag := Low(ClassFlag) to High(ClassFlag) do if ClassFlag in ClassFlags then Result := Result + TypInfo.GetEnumName(TypeInfo(TClassFlag), Ord(ClassFlag)) + ','; if Result <> '' then Delete(Result, Length(Result), 1); Result := '['+Result+']'; end; function PropertyFlagsToString(PropertyFlags: TPropertyFlags): string; var PropertyFlag: TPropertyFlag; begin Result := ''; for PropertyFlag := Low(PropertyFlag) to High(PropertyFlag) do if PropertyFlag in PropertyFlags then Result := Result + TypInfo.GetEnumName(TypeInfo(TPropertyFlag), Ord(PropertyFlag)) + ','; if Result <> '' then Delete(Result, Length(Result), 1); Result := '['+Result+']'; end; function CallingConventionToString(CallingConvention: TCallingConvention): string; var CC: TCallingConvention; begin CC := CallingConvention and ccLowerMask; case CC of ccNearC : Result :='NearC'; ccFarC : Result :='FarC'; ccNearPascal : Result :='NearPascal'; ccFarPascal : Result :='FarPascal'; ccNearFastCall : Result :='NearFastCall'; ccFarFastCall : Result :='FarFastCall'; ccPCode : Result :='PCode'; ccNearStdCall : Result :='NearStdCall'; ccFarStdCall : Result :='FarStdCall'; ccNearSysCall : Result :='NearSysCall'; ccFarSysCall : Result :='FarSysCall'; ccThisCall : Result :='ThisCall'; ccNearFastCall2 : Result :='NearFastCall2'; else Result := '??'; end; if (CallingConvention and ccFastThis) <> 0 then Result := Result + ', FastThis'; if (CallingConvention and ccVarArgs) <> 0 then Result := Result + ', VarArgs'; end; function ClassMemberAttribToString(ClassMemberAttrib: TClassMemberAttrib): string; var CrackedClassMemberAttrib: TCrackedClassMemberAttrib; begin CrackedClassMemberAttrib := CrackClassMemberAttrib(ClassMemberAttrib); Result := Format('%s, %s', [TypInfo.GetEnumName(TypeInfo(TClassMemberProtection), Ord(CrackedClassMemberAttrib.ClassMemberProtection)), TypInfo.GetEnumName(TypeInfo(TClassMemberProperty) , Ord(CrackedClassMemberAttrib.ClassMemberProperty))]); end; { TBorDebug } constructor TBorDebug.Create(const aFilename: string =''); begin inherited Create; FSkipNames := False; FCacheNames := True; FFilename := aFilename; end; destructor TBorDebug.Destroy; begin inherited Destroy; end; procedure TBorDebug.Open; begin Close; FHandle := BorDebugRegisterFileEx(FileName, SkipNames, CacheNames, True); FSubSectionDirectoryOffset := BorDebugSubSectionDirOffset(FHandle); FSubSectionCount := BorDebugSubSectionCount(FHandle); FNameCount := BorDebugNamesTotalNames(FHandle); BorDebugGlobalTypes(FHandle, FTypesSignature, FTypeCount); end; procedure TBorDebug.Close; begin if Active then begin BorDebugUnregisterFile(FHandle); FHandle := InvalidBorDebHandle; end; end; function TBorDebug.GetHandle: TBorDebHandle; begin if FHandle = InvalidBorDebHandle then Open; Result := FHandle; end; procedure TBorDebug.SetFileName(const Value: string); begin if CompareText(Value, FileName) <> 0 then begin Close; FFileName := Value; end; end; function TBorDebug.GetActive: boolean; begin Result := (FHandle <> InvalidBorDebHandle); end; procedure TBorDebug.SetActive(Value: boolean); begin if Value <> Active then begin if Value then Open else Close; end; end; function TBorDebug.GetNames(Index: TNameIndex): string; var Buffer: array[0..260] of char; begin CheckIndex(Index, NameCount); BorDebugNameIndexToName(Handle, Index, @Buffer, SizeOf(Buffer)); SetString(Result, Buffer, StrLen(Buffer)); end; function TBorDebug.GetUnmangledNames(Index: TNameIndex): string; var Buffer: array[0..1024] of char; begin CheckIndex(Index, NameCount); BorDebugNameIndexToUnmangledName(Handle, Index, @Buffer, SizeOf(Buffer)); SetString(Result, Buffer, StrLen(Buffer)); end; function TBorDebug.GetRegisterName(RegIndex: TRegNameIndex): string; var Buffer: array[0..10] of char; begin BorDebugRegIndexToName(Handle, RegIndex, @Buffer, SizeOf(Buffer)); SetString(Result, Buffer, StrLen(Buffer)); end; function TBorDebug.GetSubSections(Index: TSubSectionIndex): TBorDebugSubSection; begin CheckIndex(Index, SubSectionCount); with Result do BorDebugSubSection(Handle, Index, SubsectionType, Module, Offset, Size); end; procedure TBorDebug.StartSymbols(const SubSection: TBorDebugSubSection); begin CheckSection(SubSection.SubsectionType, [BORDEBUG_SSTALIGNSYM, BORDEBUG_SSTGLOBALSYM, BORDEBUG_SSTGLOBALPUB]); with SubSection do BorDebugStartSymbols(Handle, SubSectionType, Offset, Size); end; function TBorDebug.GetNextSymbol(var Symbol: TBorDebugSymbol): boolean; begin with Symbol do begin BorDebugNextSymbol(Handle, Kind, Offset, Len); Result := not ((Kind = 0) and (Offset = 0) and (Len = 0)) end; end; function TBorDebug.CreateSymbolInfo(const Symbol: TBorDebugSymbol): TSymbolInfo; begin Result := TSymbolInfo.Create(Self, Symbol); end; function TBorDebug.CreateTypeInfo(const aType: TBorDebugType): TTypeInfo; begin Result := TTypeInfo.Create(Self, aType); end; function TBorDebug.GetTypeFromIndex(TypeIndex: TTypeIndex): TBorDebugType; begin Result.TypeIndex := TypeIndex; with Result do BorDebugTypeFromIndex(Handle, TypeIndex, TypeOffset, Length, TypeKind); end; function TBorDebug.GetTypeFromOffset(Offset: TFileOffset): TBorDebugType; begin Result.TypeIndex := TTypeIndex(BORDEBUG_LF_INVALID_0); Result.TypeOffset:= Offset; with Result do BorDebugTypeFromOffset(Handle, TypeOffset, Length, TypeKind); end; function TBorDebug.GetTypeName(TypeIndex: TTypeIndex): string; var Buffer: array[0..260] of char; begin BorDebugTypeIndexToString(Handle, TypeIndex, @Buffer, SizeOf(Buffer)); SetString(Result, Buffer, StrLen(Buffer)); end; function TBorDebug.GetGlobalSymbols(const SubSection: TBorDebugSubSection): TBorDebugGlobalSymbol; begin CheckSection(SubSection.SubsectionType, [BORDEBUG_SSTGLOBALSYM, BORDEBUG_SSTGLOBALPUB]); with Result do BorDebugGlobalSym(Handle, SubSection.Offset, SymHashFunction, AddrHashFunction, SymTableBytes, SymHashTableBytes, AddrHashTableBytes, TotalUDTs, TotalOtherSyms, TotalSymbols, TotalNameSpaces); end; function TBorDebug.CreateModule(const SubSection: TBorDebugSubSection ): TBorDebugModule; begin CheckSection(SubSection.SubsectionType, [BORDEBUG_SSTMODULE]); Result := TBorDebugModule.Create(Self, SubSection.Offset); end; function TBorDebug.CreateSrcModule(const SubSection: TBorDebugSubSection ): TBorDebugSrcModule; begin CheckSection(SubSection.SubsectionType, [BORDEBUG_SSTSRCMODULE]); Result := TBorDebugSrcModule.Create(Self, SubSection.Offset); end; { TBorDebugObject } constructor TBorDebugObject.Create(BorDebug: TBorDebug; Offset: TFileOffset); begin inherited Create; FBorDebug := BorDebug; FOffset := Offset; end; destructor TBorDebugObject.Destroy; begin inherited Destroy; end; function TBorDebugObject.GetHandle: TBorDebHandle; begin Result := BorDebug.Handle; end; { TBorDebugModule } constructor TBorDebugModule.Create(BorDebug: TBorDebug; Offset: TFileOffset); var SegmentIndex: integer; begin inherited Create(BorDebug, Offset); // Get the static information about the Module and number of segments BorDebugModule(Handle, Offset, FOverlay, FLibIndex, FStyle, FNameIndex, FTimeStamp, FSegmentCount); // For each segment in for this source module, get details about the segment FModuleSegmentList := TList.Create; FModuleSegmentList.Capacity := SegmentCount; for SegmentIndex := 0 to SegmentCount-1 do FModuleSegmentList.Add(TModuleSegment.Create(Self, SegmentIndex)); end; destructor TBorDebugModule.Destroy; begin FreeTList(FModuleSegmentList); inherited Destroy; end; function TBorDebugModule.GetName: string; begin Result := BorDebug.Names[NameIndex]; end; function TBorDebugModule.GetSegments(Index: integer): TModuleSegment; begin Result := TModuleSegment(FModuleSegmentList[Index]); end; { TBorDebugSrcModule } constructor TBorDebugSrcModule.Create(BorDebug: TBorDebug; Offset: TFileOffset); var SourceFileIndex: TSourceFileIndex; begin inherited Create(BorDebug, Offset); // Get the number of ranges BorDebugSrcModule(BorDebug.Handle, Offset, FRangeCount, FSourceCount); // Allocate enough memory for each module range array GetMem(FRangeSegments , RangeCount * SizeOf(FRangeSegments ^[0])); GetMem(FRangeSegmentStarts, RangeCount * SizeOf(FRangeSegmentStarts^[0])); GetMem(FRangeSegmentEnds , RangeCount * SizeOf(FRangeSegmentEnds ^[0])); // Now get the segment index, start and end offsets for each range BorDebugSrcModuleRanges(BorDebug.Handle, Offset, FRangeSegments, FRangeSegmentStarts, FRangeSegmentEnds); // Allocate enough memory for each source file array GetMem(FSourceOffsets , SourceCount * SizeOf(FSourceOffsets ^[0])); GetMem(FNameIndices , SourceCount * SizeOf(FNameIndices ^[0])); GetMem(FRangeCounts , SourceCount * SizeOf(FRangeCounts ^[0])); // Now get the source segment offsets, name indecies and range counts BorDebugSrcModuleSources(BorDebug.Handle, Offset, FSourceOffsets, FNameIndices, FRangeCounts); // For each source file, get the range and line number details FSourceFileList := TList.Create; FSourceFileList.Capacity := SourceCount; for SourceFileIndex := 0 to SourceCount-1 do FSourceFileList.Add(TSourceFileEntry.Create(Self, SourceFileIndex)); end; destructor TBorDebugSrcModule.Destroy; begin FreeTList(FSourceFileList); FreePtr(FRangeCounts ); FreePtr(FNameIndices ); FreePtr(FSourceOffsets ); FreePtr(FRangeSegmentEnds ); FreePtr(FRangeSegmentStarts); FreePtr(FRangeSegments ); inherited Destroy; end; function TBorDebugSrcModule.GetSources(Index: integer): TSourceFileEntry; begin Result := TSourceFileEntry(FSourceFileList[Index]); end; function TBorDebugSrcModule.GetSourceNames(Index: integer): string; begin CheckIndex(Index, SourceCount); Result := BorDebug.Names[NameIndices^[Index]]; end; { TModuleSegment } constructor TModuleSegment.Create(Module : TBorDebugModule; SegmentIndex : TSegmentIndex); begin inherited Create; BorDebugModuleSegment(Module.Handle, Module.Offset, SegmentIndex, FLinkerSegment, FOffset, FSize, FFlags); end; { TSourceFileEntry } constructor TSourceFileEntry.Create(SrcModule : TBorDebugSrcModule; SourceFileIndex : TSourceFileIndex); var RangeIndex : TRangeIndex; RangeCount : TItemCount; begin inherited Create; FSrcModule := SrcModule; FSourceFileIndex := SourceFileIndex; RangeCount := Self.RangeCount; // Allocate enough memory for the ranges in this source file GetMem(FRangeSegments , RangeCount * SizeOf(FRangeSegments ^[0])); GetMem(FRangeSegmentStarts, RangeCount * SizeOf(FRangeSegmentStarts^[0])); GetMem(FRangeSegmentEnds , RangeCount * SizeOf(FRangeSegmentEnds ^[0])); GetMem(FLineNumberCounts , RangeCount * SizeOf(FLineNumberCounts ^[0])); // Now get the information for each range //TODO: Should be own offset!? BorDebugSrcModuleSourceRanges(Handle, Offset, SourceFileIndex, FRangeSegments, FRangeSegmentStarts, FRangeSegmentEnds, FLineNumberCounts); // For each range, get the line number details FLineNumerOffsetList := TList.Create; FLineNumerOffsetList.Capacity := RangeCount; for RangeIndex := 0 to RangeCount-1 do FLineNumerOffsetList.Add(TLineNumberOffsets.Create(Self, RangeIndex)); end; destructor TSourceFileEntry.Destroy; begin FreeTList(FLineNumerOffsetList); FreePtr(FLineNumberCounts ); FreePtr(FRangeSegmentEnds ); FreePtr(FRangeSegmentStarts); FreePtr(FRangeSegments ); inherited Destroy; end; function TSourceFileEntry.GetBorDebug: TBorDebug; begin Result := SrcModule.BorDebug; end; function TSourceFileEntry.GetHandle: TBorDebHandle; begin Result := SrcModule.Handle; end; function TSourceFileEntry.GetName: string; begin Result := BorDebug.Names[NameIndex]; end; function TSourceFileEntry.GetNameIndex: TNameIndex; begin Result := SrcModule.NameIndices[SourceFileIndex]; end; function TSourceFileEntry.GetOffset: TFileOffset; begin Result := SrcModule.Offset; end; function TSourceFileEntry.GetRangeCount: TItemCount; begin Result := SrcModule.RangeCounts[SourceFileIndex]; end; function TSourceFileEntry.GetRangeLineNumbers(Index: integer): TLineNumberOffsets; begin Result := TLineNumberOffsets(FLineNumerOffsetList[Index]); end; { TLineNumberOffsets } constructor TLineNumberOffsets.Create(SourceFile : TSourceFileEntry; RangeIndex : TRangeIndex); var LineCount: TItemCount; begin inherited Create; FSourceFile := SourceFile; FRangeIndex := RangeIndex; LineCount := Self.LineCount; // Allocate enough memory for the line number/offset pairs GetMem(FLineNumbers, LineCount * SizeOf(FLineNumbers^[0])); GetMem(FLineOffsets, LineCount * SizeOf(FLineOffsets^[0])); // Now get the line number/offset pairs BorDebugSrcModuleLineNumbers(SourceFile.Handle, SourceFile.Offset, SourceFile.SourceFileIndex, RangeIndex, FLineNumbers, FLineOffsets); end; destructor TLineNumberOffsets.Destroy; begin FreePtr(FLineOffsets); FreePtr(FLineNumbers); inherited Destroy; end; function TLineNumberOffsets.GetLineCount: TItemCount; begin Result := SourceFile.LineNumberCounts[RangeIndex]; end; { TSymbolInfo } constructor TSymbolInfo.Create(BorDebug: TBorDebug; Symbol: TBorDebugSymbol); var Handle : TBorDebHandle; TmpName: array[0..255] of char; begin inherited Create; FInfoRec.Symbol := Symbol; Handle := BorDebug.Handle; case Kind of BORDEBUG_S_COMPILE : begin New(FInfoRec.COMPILESymbol); with FInfoRec.COMPILESymbol^ do begin BorDebugSymbolCOMPILE( Handle, SymbolOffset, Machine, Language, Flags, @TmpName, SizeOf(TmpName)); GetMem(CompilerName, StrLen(TmpName)); StrCopy(CompilerName, TmpName); end; end; BORDEBUG_S_REGISTER : begin New(FInfoRec.REGISTERSymbol); with FInfoRec.REGISTERSymbol^ do begin BorDebugSymbolREGISTER( Handle, SymbolOffset, TypeIndex, RegisterIndex, NameIndex, BrowserOffset); end; end; BORDEBUG_S_CONST : begin New(FInfoRec.CONSTSymbol); with FInfoRec.CONSTSymbol^ do begin BorDebugSymbolCONST( Handle, SymbolOffset, TypeIndex, NameIndex, BrowserOffset, Value); end; end; BORDEBUG_S_UDT : begin New(FInfoRec.UDTSymbol); with FInfoRec.UDTSymbol^ do begin BorDebugSymbolUDT( Handle, SymbolOffset, TypeIndex, Properties, NameIndex, BrowserOffset); end; end; BORDEBUG_S_SSEARCH : begin New(FInfoRec.SSEARCHSymbol); with FInfoRec.SSEARCHSymbol^ do begin BorDebugSymbolSSEARCH( Handle, SymbolOffset, FirstProcSegment, FirstProcOffset, CodeSymCount, DataSymCount, FirstData); end; end; BORDEBUG_S_OBJNAME : begin New(FInfoRec.OBJNAMESymbol); with FInfoRec.OBJNAMESymbol^ do begin BorDebugSymbolOBJNAME( Handle, SymbolOffset, Signature, NameIndex); end; end; BORDEBUG_S_GPROCREF : begin New(FInfoRec.GPROCREFSymbol); with FInfoRec.GPROCREFSymbol^ do begin BorDebugSymbolGPROCREF( Handle, SymbolOffset, RefSymOffset, TypeIndex, NameIndex, BrowserOffset, CodeSegment, CodeOffset); end; end; BORDEBUG_S_GDATAREF : begin New(FInfoRec.GDATAREFSymbol); with FInfoRec.GDATAREFSymbol^ do begin BorDebugSymbolGDATAREF( Handle, SymbolOffset, RefSymOffset, TypeIndex, NameIndex, BrowserOffset, DataSegment, DataOffset); end; end; BORDEBUG_S_EDATA : begin New(FInfoRec.EDATASymbol); with FInfoRec.EDATASymbol^ do begin BorDebugSymbolEDATA( Handle, SymbolOffset, TypeIndex, NameIndex, ExternIndex, Flags, BrowserOffset); end; end; BORDEBUG_S_EPROC : begin New(FInfoRec.EPROCSymbol); with FInfoRec.EPROCSymbol^ do begin BorDebugSymbolEPROC( Handle, SymbolOffset, TypeIndex, NameIndex, ExternIndex, Flags, BrowserOffset); end; end; BORDEBUG_S_USES : begin New(FInfoRec.USESSymbol); with FInfoRec.USESSymbol^ do begin NameCount := BorDebugSymbolUSES( Handle, SymbolOffset, 0, nil); GetMem(NameIndices, NameCount * SizeOf(NameIndices^[0])); BorDebugSymbolUSES( Handle, SymbolOffset, NameCount, NameIndices); end; end; BORDEBUG_S_NAMESPACE : begin New(FInfoRec.NAMESPACESymbol); with FInfoRec.NAMESPACESymbol^ do begin UsingCount := BorDebugSymbolNAMESPACE( Handle, SymbolOffset, 0, NameIndex, BrowserOffset, nil); GetMem(UsingIndices, UsingCount * SizeOf(UsingIndices^[0])); BorDebugSymbolNAMESPACE( Handle, SymbolOffset, UsingCount, NameIndex, BrowserOffset, UsingIndices); end; end; BORDEBUG_S_USING : begin New(FInfoRec.USINGSymbol); with FInfoRec.USINGSymbol^ do begin NameCount := BorDebugSymbolUSING( Handle, SymbolOffset, 0, nil); GetMem(NameIndices, NameCount * SizeOf(NameIndices^[0])); BorDebugSymbolUSING( Handle, SymbolOffset, NameCount, NameIndices); end; end; BORDEBUG_S_PCONSTANT : begin New(FInfoRec.PCONSTANTSymbol); with FInfoRec.PCONSTANTSymbol^ do begin //!! FillChar(FInfoRec.PCONSTANTSymbol^, SizeOf(FInfoRec.PCONSTANTSymbol^), 0); ValueLen := BorDebugSymbolPCONSTANT( Handle, SymbolOffset, TypeIndex, NameIndex, Properties, BrowserOffset, SizeOf(TmpName), @TmpName); // Bug workaround! GetMem(Value, ValueLen); if ValueLen < SizeOf(TmpName) then StrCopy(Value, TmpName) else BorDebugSymbolPCONSTANT( Handle, SymbolOffset, TypeIndex, NameIndex, Properties, BrowserOffset, ValueLen, Value); end; end; BORDEBUG_S_BPREL32 : begin New(FInfoRec.BPREL32Symbol); with FInfoRec.BPREL32Symbol^ do begin BorDebugSymbolBPREL32( Handle, SymbolOffset, EBPOffset, TypeIndex, NameIndex, BrowserOffset); end; end; BORDEBUG_S_LDATA32 : begin New(FInfoRec.LDATA32Symbol); with FInfoRec.LDATA32Symbol^ do begin BorDebugSymbolLDATA32( Handle, SymbolOffset, Offset, Segment, Flags, TypeIndex, NameIndex, BrowserOffset); end; end; BORDEBUG_S_GDATA32 : begin New(FInfoRec.GDATA32Symbol); with FInfoRec.GDATA32Symbol^ do begin BorDebugSymbolGDATA32( Handle, SymbolOffset, Offset, Segment, Flags, TypeIndex, NameIndex, BrowserOffset); end; end; BORDEBUG_S_PUB32 : begin New(FInfoRec.PUB32Symbol); with FInfoRec.PUB32Symbol^ do begin BorDebugSymbolPUB32( Handle, SymbolOffset, Offset, Segment, Flags, TypeIndex, NameIndex, BrowserOffset); end; end; BORDEBUG_S_LPROC32 : begin New(FInfoRec.LPROC32Symbol); with FInfoRec.LPROC32Symbol^ do begin BorDebugSymbolLPROC32( Handle, SymbolOffset, Parent, End_, Next, CodeLength, DebugStart, DebugEnd, Offset, Segment, Flags, TypeIndex, NameIndex, BrowserOffset); end; end; BORDEBUG_S_GPROC32 : begin New(FInfoRec.GPROC32Symbol); with FInfoRec.GPROC32Symbol^ do begin LinkNameLen := BorDebugSymbolGPROC32( Handle, SymbolOffset, Parent, End_, Next, CodeLength, DebugStart, DebugEnd, Offset, Segment, Flags, TypeIndex, NameIndex, BrowserOffset, nil, 0); GetMem(LinkName, LinkNameLen); BorDebugSymbolGPROC32( Handle, SymbolOffset, Parent, End_, Next, CodeLength, DebugStart, DebugEnd, Offset, Segment, Flags, TypeIndex, NameIndex, BrowserOffset, LinkName, LinkNameLen); end; end; BORDEBUG_S_THUNK32 : begin New(FInfoRec.THUNK32Symbol); with FInfoRec.THUNK32Symbol^ do begin BorDebugSymbolTHUNK32( Handle, SymbolOffset, Parent, End_, Next, Offset, Segment, CodeLength, Ordinal, NameIndex, Delta); end; end; BORDEBUG_S_BLOCK32 : begin New(FInfoRec.BLOCK32Symbol); with FInfoRec.BLOCK32Symbol^ do begin BorDebugSymbolBLOCK32( Handle, SymbolOffset, Parent, End_, CodeLength, Offset, Segment, NameIndex); end; end; BORDEBUG_S_WITH32 : begin New(FInfoRec.WITH32Symbol); with FInfoRec.WITH32Symbol^ do begin BorDebugSymbolWITH32( Handle, SymbolOffset, Parent, CodeLength, Offset, Segment, Flags, TypeIndex, NameIndex, VarOffset); end; end; BORDEBUG_S_LABEL32 : begin New(FInfoRec.LABEL32Symbol); with FInfoRec.LABEL32Symbol^ do begin BorDebugSymbolLABEL32( Handle, SymbolOffset, Offset, Segment, NearFar, NameIndex); end; end; BORDEBUG_S_ENTRY32 : begin New(FInfoRec.ENTRY32Symbol); with FInfoRec.ENTRY32Symbol^ do begin BorDebugSymbolENTRY32( Handle, SymbolOffset, Offset, Segment); end; end; BORDEBUG_S_OPTVAR32 : begin New(FInfoRec.OPTVAR32Symbol); with FInfoRec.OPTVAR32Symbol^ do begin EntryCount := BorDebugSymbolOPTVAR32( Handle, SymbolOffset, 0, nil, nil, nil); GetMem(StartEntries , EntryCount * SizeOf(StartEntries ^[0])); GetMem(LengthEntries , EntryCount * SizeOf(LengthEntries ^[0])); GetMem(RegNameEntries, EntryCount * SizeOf(RegNameEntries^[0])); BorDebugSymbolOPTVAR32( Handle, SymbolOffset, EntryCount, StartEntries, LengthEntries, RegNameEntries); end; end; BORDEBUG_S_PROCRET32 : begin New(FInfoRec.PROCRET32Symbol); with FInfoRec.PROCRET32Symbol^ do begin BorDebugSymbolPROCRET32( Handle, SymbolOffset, Offset, Length); end; end; BORDEBUG_S_SAVREGS32 : begin New(FInfoRec.SAVREGS32Symbol); with FInfoRec.SAVREGS32Symbol^ do begin BorDebugSymbolSAVREGS32( Handle, SymbolOffset, Mask, EBPOffset); end; end; BORDEBUG_S_SLINK32 : begin New(FInfoRec.SLINK32Symbol); with FInfoRec.SLINK32Symbol^ do begin EBPOffset := BorDebugSymbolSLINK32( Handle, SymbolOffset); end; end; end; end; destructor TSymbolInfo.Destroy; begin case Kind of BORDEBUG_S_COMPILE : begin FreeMem(FInfoRec.COMPILESymbol.CompilerName); Dispose(FInfoRec.COMPILESymbol); end; BORDEBUG_S_REGISTER : begin Dispose(FInfoRec.REGISTERSymbol); end; BORDEBUG_S_CONST : begin Dispose(FInfoRec.CONSTSymbol); end; BORDEBUG_S_UDT : begin Dispose(FInfoRec.UDTSymbol); end; BORDEBUG_S_SSEARCH : begin Dispose(FInfoRec.SSEARCHSymbol); end; BORDEBUG_S_OBJNAME : begin Dispose(FInfoRec.OBJNAMESymbol); end; BORDEBUG_S_GPROCREF : begin Dispose(FInfoRec.GPROCREFSymbol); end; BORDEBUG_S_GDATAREF : begin Dispose(FInfoRec.GDATAREFSymbol); end; BORDEBUG_S_EDATA : begin Dispose(FInfoRec.EDATASymbol); end; BORDEBUG_S_EPROC : begin Dispose(FInfoRec.EPROCSymbol); end; BORDEBUG_S_USES : begin FreeMem(FInfoRec.USESSymbol^.NameIndices); Dispose(FInfoRec.USESSymbol); end; BORDEBUG_S_NAMESPACE : begin FreeMem(FInfoRec.NAMESPACESymbol^.UsingIndices); Dispose(FInfoRec.NAMESPACESymbol); end; BORDEBUG_S_USING : begin FreeMem(FInfoRec.USINGSymbol^.NameIndices); Dispose(FInfoRec.USINGSymbol); end; BORDEBUG_S_PCONSTANT : begin FreeMem(FInfoRec.PCONSTANTSymbol^.Value); Dispose(FInfoRec.PCONSTANTSymbol); end; BORDEBUG_S_BPREL32 : begin Dispose(FInfoRec.BPREL32Symbol); end; BORDEBUG_S_LDATA32 : begin Dispose(FInfoRec.LDATA32Symbol); end; BORDEBUG_S_GDATA32 : begin Dispose(FInfoRec.GDATA32Symbol); end; BORDEBUG_S_PUB32 : begin Dispose(FInfoRec.PUB32Symbol); end; BORDEBUG_S_LPROC32 : begin Dispose(FInfoRec.LPROC32Symbol); end; BORDEBUG_S_GPROC32 : begin FreeMem(FInfoRec.GPROC32Symbol^.LinkName); Dispose(FInfoRec.GPROC32Symbol); end; BORDEBUG_S_THUNK32 : begin Dispose(FInfoRec.THUNK32Symbol); end; BORDEBUG_S_BLOCK32 : begin Dispose(FInfoRec.BLOCK32Symbol); end; BORDEBUG_S_WITH32 : begin Dispose(FInfoRec.WITH32Symbol); end; BORDEBUG_S_LABEL32 : begin Dispose(FInfoRec.LABEL32Symbol); end; BORDEBUG_S_ENTRY32 : begin Dispose(FInfoRec.ENTRY32Symbol); end; BORDEBUG_S_OPTVAR32 : begin FreeMem(FInfoRec.OPTVAR32Symbol^.StartEntries ); FreeMem(FInfoRec.OPTVAR32Symbol^.LengthEntries ); FreeMem(FInfoRec.OPTVAR32Symbol^.RegNameEntries); Dispose(FInfoRec.OPTVAR32Symbol); end; BORDEBUG_S_PROCRET32 : begin Dispose(FInfoRec.PROCRET32Symbol); end; BORDEBUG_S_SAVREGS32 : begin Dispose(FInfoRec.SAVREGS32Symbol); end; BORDEBUG_S_SLINK32 : begin Dispose(FInfoRec.SLINK32Symbol); end; end; // We could have avoided all the Dispose-calls above by doing: // // FreeMem(FInfoRec.SymbolPtr) // // But if we later add strings, variants, interfaces or other auto-managed // fields that must be finalized, the code would break (i.e. leak) FInfoRec.SymbolPtr := nil; inherited Destroy; end; function TSymbolInfo.GetTypeIndex(var TypeIndex: TTypeIndex): boolean; begin Result := True; case Kind of BORDEBUG_S_REGISTER : TypeIndex := FInfoRec.REGISTERSymbol^.TypeIndex; BORDEBUG_S_CONST : TypeIndex := FInfoRec.CONSTSymbol^.TypeIndex; BORDEBUG_S_UDT : TypeIndex := FInfoRec.UDTSymbol^.TypeIndex; BORDEBUG_S_GPROCREF : TypeIndex := FInfoRec.GPROCREFSymbol^.TypeIndex; BORDEBUG_S_GDATAREF : TypeIndex := FInfoRec.GDATAREFSymbol^.TypeIndex; BORDEBUG_S_EDATA : TypeIndex := FInfoRec.EDATASymbol^.TypeIndex; BORDEBUG_S_EPROC : TypeIndex := FInfoRec.EPROCSymbol^.TypeIndex; BORDEBUG_S_PCONSTANT : TypeIndex := FInfoRec.PCONSTANTSymbol^.TypeIndex; BORDEBUG_S_BPREL32 : TypeIndex := FInfoRec.BPREL32Symbol^.TypeIndex; BORDEBUG_S_LDATA32 : TypeIndex := FInfoRec.LDATA32Symbol^.TypeIndex; BORDEBUG_S_GDATA32 : TypeIndex := FInfoRec.GDATA32Symbol^.TypeIndex; BORDEBUG_S_PUB32 : TypeIndex := FInfoRec.PUB32Symbol^.TypeIndex; BORDEBUG_S_LPROC32 : TypeIndex := FInfoRec.LPROC32Symbol^.TypeIndex; BORDEBUG_S_GPROC32 : TypeIndex := FInfoRec.GPROC32Symbol^.TypeIndex; BORDEBUG_S_WITH32 : TypeIndex := FInfoRec.WITH32Symbol^.TypeIndex; else Result := False; end; end; function TSymbolInfo.GetNameIndex(var NameIndex: TNameIndex): boolean; begin Result := True; case Kind of BORDEBUG_S_REGISTER : NameIndex := FInfoRec.REGISTERSymbol^.NameIndex; BORDEBUG_S_CONST : NameIndex := FInfoRec.CONSTSymbol^.NameIndex; BORDEBUG_S_UDT : NameIndex := FInfoRec.UDTSymbol^.NameIndex; BORDEBUG_S_OBJNAME : NameIndex := FInfoRec.OBJNAMESymbol^.NameIndex; BORDEBUG_S_GPROCREF : NameIndex := FInfoRec.GPROCREFSymbol^.NameIndex; BORDEBUG_S_GDATAREF : NameIndex := FInfoRec.GDATAREFSymbol^.NameIndex; BORDEBUG_S_EDATA : NameIndex := FInfoRec.EDATASymbol^.NameIndex; BORDEBUG_S_EPROC : NameIndex := FInfoRec.EPROCSymbol^.NameIndex; BORDEBUG_S_NAMESPACE : NameIndex := FInfoRec.NAMESPACESymbol^.NameIndex; BORDEBUG_S_PCONSTANT : NameIndex := FInfoRec.PCONSTANTSymbol^.NameIndex; BORDEBUG_S_BPREL32 : NameIndex := FInfoRec.BPREL32Symbol^.NameIndex; BORDEBUG_S_LDATA32 : NameIndex := FInfoRec.LDATA32Symbol^.NameIndex; BORDEBUG_S_GDATA32 : NameIndex := FInfoRec.GDATA32Symbol^.NameIndex; BORDEBUG_S_PUB32 : NameIndex := FInfoRec.PUB32Symbol^.NameIndex; BORDEBUG_S_LPROC32 : NameIndex := FInfoRec.LPROC32Symbol^.NameIndex; BORDEBUG_S_GPROC32 : NameIndex := FInfoRec.GPROC32Symbol^.NameIndex; BORDEBUG_S_THUNK32 : NameIndex := FInfoRec.THUNK32Symbol^.NameIndex; BORDEBUG_S_BLOCK32 : NameIndex := FInfoRec.BLOCK32Symbol^.NameIndex; BORDEBUG_S_WITH32 : NameIndex := FInfoRec.WITH32Symbol^.NameIndex; BORDEBUG_S_LABEL32 : NameIndex := FInfoRec.LABEL32Symbol^.NameIndex; else Result := False; end; end; function TSymbolInfo.GetKindAsString: string; begin Result := SymbolKindToString(Kind); end; { TTypeInfo } constructor TTypeInfo.Create(BorDebug: TBorDebug; aType: TBorDebugType); var Handle : TBorDebHandle; TmpName: array[0..255] of char; begin inherited Create; FInfoRec.BDType := aType; Handle := BorDebug.Handle; case TypeKind of BORDEBUG_LF_MODIFIER : begin New(FInfoRec.MODIFIERType); with FInfoRec.MODIFIERType^ do begin BorDebugTypeMODIFIER( Handle, TypeOffset, Attributes, TypeIndex); end; end; BORDEBUG_LF_POINTER : begin New(FInfoRec.POINTERType); with FInfoRec.POINTERType^ do begin BorDebugTypePOINTER( Handle, TypeOffset, Attributes, TypeIndex, Value1, Value2); end; end; BORDEBUG_LF_ARRAY : begin New(FInfoRec.ARRAYType); with FInfoRec.ARRAYType^ do begin BorDebugTypeARRAY( Handle, TypeOffset, ElementType, IndexType, NameIndex, Size, Elements); end; end; BORDEBUG_LF_STRUCT, BORDEBUG_LF_CLASS : begin New(FInfoRec.CLASSType); with FInfoRec.CLASSType^ do begin BorDebugTypeCLASS( Handle, TypeOffset, FieldCount, FieldList, ClassFlags, ContainingClass, DerivationList, Vtable, NameIndex, ClassSize); end; end; BORDEBUG_LF_UNION : begin New(FInfoRec.UNIONType); with FInfoRec.UNIONType^ do begin BorDebugTypeUNION( Handle, TypeOffset, FieldCount, FieldList, ClassFlags, ContainingClass, NameIndex, ClassSize); end; end; BORDEBUG_LF_ENUM : begin New(FInfoRec.ENUMType); with FInfoRec.ENUMType^ do begin BorDebugTypeENUM( Handle, TypeOffset, MemberCount, UnderlyingType, MemberList, ContainingClass, NameIndex); end; end; BORDEBUG_LF_PROCEDURE : begin New(FInfoRec.PROCEDUREType); with FInfoRec.PROCEDUREType^ do begin BorDebugTypePROCEDURE( Handle, TypeOffset, ReturnType, CallingConvention, ArgCount, ArgList); end; end; BORDEBUG_LF_MFUNCTION : begin New(FInfoRec.MFUNCTIONType); with FInfoRec.MFUNCTIONType^ do begin BorDebugTypeMFUNCTION( Handle, TypeOffset, ReturnType, ClassType, ThisType, CallingConvention, ArgCount, ArgList, ThisAdjust); end; end; BORDEBUG_LF_VTSHAPE : begin New(FInfoRec.VTSHAPEType); with FInfoRec.VTSHAPEType^ do begin DescriptorCount := BorDebugTypeVTSHAPE( Handle, TypeOffset, 0, nil); GetMem(DescriptorArray, DescriptorCount * SizeOf(DescriptorArray^[0])); BorDebugTypeVTSHAPE( Handle, TypeOffset, DescriptorCount, DescriptorArray); end; end; BORDEBUG_LF_LABEL : begin New(FInfoRec.LABELType); with FInfoRec.LABELType^ do begin NearFar := BorDebugTypeLABEL( Handle, TypeOffset); end; end; BORDEBUG_LF_SET : begin New(FInfoRec.SETType); with FInfoRec.SETType^ do begin BorDebugTypeSET( Handle, TypeOffset, ElemType, NameIndex, LowByte, Length); end; end; BORDEBUG_LF_SUBRANGE : begin New(FInfoRec.SUBRANGEType); with FInfoRec.SUBRANGEType^ do begin BorDebugTypeSUBRANGE( Handle, TypeOffset, BaseType, NameIndex, LoBound, HiBound, Size); end; end; BORDEBUG_LF_PARRAY : begin New(FInfoRec.PARRAYType); with FInfoRec.PARRAYType^ do begin BorDebugTypePARRAY( Handle, TypeOffset, ElementType, IndexType, NameIndex, Size, Elements); end; end; BORDEBUG_LF_PSTRING : begin New(FInfoRec.PSTRINGType); with FInfoRec.PSTRINGType^ do begin BorDebugTypePSTRING( Handle, TypeOffset, ElemType, IndexType, NameIndex); end; end; BORDEBUG_LF_CLOSURE : begin New(FInfoRec.CLOSUREType); with FInfoRec.CLOSUREType^ do begin BorDebugTypeCLOSURE( Handle, TypeOffset, ReturnType, CallingConvention, ArgCount, ArgList); end; end; BORDEBUG_LF_PROPERTY : begin New(FInfoRec.PROPERTYType); with FInfoRec.PROPERTYType^ do begin BorDebugTypePROPERTY( Handle, TypeOffset, TypeIndex, Flags, ArrayIndex, PropIndex, ReadSlot, WriteSlot); end; end; BORDEBUG_LF_LSTRING : begin New(FInfoRec.LSTRINGType); with FInfoRec.LSTRINGType^ do begin NameIndex := BorDebugTypeLSTRING( Handle, TypeOffset); end; end; BORDEBUG_LF_VARIANT : begin New(FInfoRec.VARIANTType); with FInfoRec.VARIANTType^ do begin NameIndex := BorDebugTypeVARIANT( Handle, TypeOffset); end; end; BORDEBUG_LF_CLASSREF : begin New(FInfoRec.CLASSREFType); with FInfoRec.CLASSREFType^ do begin BorDebugTypeCLASSREF( Handle, TypeOffset, RefType, VtShape); end; end; BORDEBUG_LF_WSTRING : begin New(FInfoRec.WSTRINGType); with FInfoRec.WSTRINGType^ do begin NameIndex := BorDebugTypeWSTRING( Handle, TypeOffset); end; end; BORDEBUG_LF_ARGLIST : begin New(FInfoRec.ARGLISTType); with FInfoRec.ARGLISTType^ do begin TypeCount := BorDebugTypeARGLIST( Handle, TypeOffset, 0, nil); GetMem(TypeArray, TypeCount * SizeOf(TypeArray^[0])); BorDebugTypeARGLIST( Handle, TypeOffset, TypeCount, TypeArray); end; end; BORDEBUG_LF_DERIVED : begin New(FInfoRec.DERIVEDType); with FInfoRec.DERIVEDType^ do begin TypeCount := BorDebugTypeDERIVED( Handle, TypeOffset, 0, nil); GetMem(DerivedTypes, TypeCount * SizeOf(DerivedTypes^[0])); BorDebugTypeDERIVED( Handle, TypeOffset, TypeCount, DerivedTypes); end; end; BORDEBUG_LF_BITFIELD : begin New(FInfoRec.BITFIELDType); with FInfoRec.BITFIELDType^ do begin BorDebugTypeBITFIELD( Handle, TypeOffset, Length, Position, TypeIndex); end; end; BORDEBUG_LF_METHODLIST : begin New(FInfoRec.METHODLISTType); with FInfoRec.METHODLISTType^ do begin MethodCount := BorDebugTypeMETHODLIST( Handle, TypeOffset, 0, nil, nil, nil, nil); GetMem(TypeArray, MethodCount * SizeOf(TypeArray^[0])); GetMem(AttribArray, MethodCount * SizeOf(AttribArray^[0])); GetMem(BrowserArray, MethodCount * SizeOf(BrowserArray^[0])); GetMem(VtabOffArray, MethodCount * SizeOf(VtabOffArray^[0])); BorDebugTypeMETHODLIST( Handle, TypeOffset, MethodCount, TypeArray, AttribArray, BrowserArray, VtabOffArray); end; end; BORDEBUG_LF_BCLASS : begin New(FInfoRec.BCLASSType); with FInfoRec.BCLASSType^ do begin BorDebugTypeBCLASS( Handle, TypeOffset, BaseType, Attrib, Offset); end; end; BORDEBUG_LF_VBCLASS : begin New(FInfoRec.VBCLASSType); with FInfoRec.VBCLASSType^ do begin BorDebugTypeVBCLASS( Handle, TypeOffset, vbType, vbpType, Attrib, VbpOffset, Offset); end; end; BORDEBUG_LF_IVBCLASS : begin New(FInfoRec.IVBCLASSType); with FInfoRec.IVBCLASSType^ do begin BorDebugTypeIVBCLASS( Handle, TypeOffset, vbType, vbpType, Attrib, VbpOffset, Offset); end; end; BORDEBUG_LF_ENUMERATE : begin New(FInfoRec.ENUMERATEType); with FInfoRec.ENUMERATEType^ do begin BorDebugTypeENUMERATE( Handle, TypeOffset, Attrib, NameIndex, BrowserOffset, Value); end; end; BORDEBUG_LF_FRIENDFCN : begin New(FInfoRec.FRIENDFCNType); with FInfoRec.FRIENDFCNType^ do begin BorDebugTypeFRIENDFCN( Handle, TypeOffset, TypeIndex, NameIndex); end; end; BORDEBUG_LF_INDEX : begin New(FInfoRec.INDEXTypeR); with FInfoRec.INDEXTypeR^ do begin TypeIndex := BorDebugTypeINDEX( Handle, TypeOffset); end; end; BORDEBUG_LF_MEMBER : begin New(FInfoRec.MEMBERType); with FInfoRec.MEMBERType^ do begin BorDebugTypeMEMBER( Handle, TypeOffset, TypeIndex, Attrib, NameIndex, Offset, BrowserOffset); end; end; BORDEBUG_LF_STMEMBER : begin New(FInfoRec.STMEMBERType); with FInfoRec.STMEMBERType^ do begin BorDebugTypeSTMEMBER( Handle, TypeOffset, TypeIndex, Attrib, NameIndex, BrowserOffset); end; end; BORDEBUG_LF_METHOD : begin New(FInfoRec.METHODType); with FInfoRec.METHODType^ do begin BorDebugTypeMETHOD( Handle, TypeOffset, OverloadedCount, MethodList, NameIndex); end; end; BORDEBUG_LF_NESTTYPE : begin New(FInfoRec.NESTTYPEType); with FInfoRec.NESTTYPEType^ do begin BorDebugTypeNESTTYPE( Handle, TypeOffset, TypeIndex, NameIndex, BrowserOffset); end; end; BORDEBUG_LF_VFUNCTAB : begin New(FInfoRec.VFUNCTABType); with FInfoRec.VFUNCTABType^ do begin BorDebugTypeVFUNCTAB( Handle, TypeOffset, TypeIndex, Offset); end; end; BORDEBUG_LF_FRIENDCLS : begin New(FInfoRec.FRIENDCLSType); with FInfoRec.FRIENDCLSType^ do begin TypeIndex := BorDebugTypeFRIENDCLS( Handle, TypeOffset); end; end; BORDEBUG_LF_CHAR : begin New(FInfoRec.CHARType); with FInfoRec.CHARType^ do begin Value := BorDebugTypeCHAR( Handle, TypeOffset); end; end; BORDEBUG_LF_SHORT : begin New(FInfoRec.SHORTType); with FInfoRec.SHORTType^ do begin Value := BorDebugTypeSHORT( Handle, TypeOffset); end; end; BORDEBUG_LF_USHORT : begin New(FInfoRec.USHORTType); with FInfoRec.USHORTType^ do begin Value := BorDebugTypeUSHORT( Handle, TypeOffset); end; end; BORDEBUG_LF_LONG : begin New(FInfoRec.LONGType); with FInfoRec.LONGType^ do begin Value := BorDebugTypeLONG( Handle, TypeOffset); end; end; BORDEBUG_LF_ULONG : begin New(FInfoRec.ULONGType); with FInfoRec.ULONGType^ do begin Value := BorDebugTypeULONG( Handle, TypeOffset); end; end; BORDEBUG_LF_REAL32 : begin New(FInfoRec.REAL32Type); with FInfoRec.REAL32Type^ do begin Value := BorDebugTypeREAL32( Handle, TypeOffset); end; end; BORDEBUG_LF_REAL64 : begin New(FInfoRec.REAL64Type); with FInfoRec.REAL64Type^ do begin Value := BorDebugTypeREAL64( Handle, TypeOffset); end; end; BORDEBUG_LF_REAL80 : begin New(FInfoRec.REAL80Type); with FInfoRec.REAL80Type^ do begin Value := BorDebugTypeREAL80( Handle, TypeOffset); end; end; BORDEBUG_LF_QUADWORD : begin New(FInfoRec.QUADWORDType); with FInfoRec.QUADWORDType^ do begin Value := BorDebugTypeQUADWORD( Handle, TypeOffset); end; end; BORDEBUG_LF_UQUADWORD : begin New(FInfoRec.UQUADWORDType); with FInfoRec.UQUADWORDType^ do begin Value := BorDebugTypeUQUADWORD( Handle, TypeOffset); end; end; BORDEBUG_LF_REAL48 : begin New(FInfoRec.REAL48Type); with FInfoRec.REAL48Type^ do begin Value := BorDebugTypeREAL48( Handle, TypeOffset); end; end; end; end; destructor TTypeInfo.Destroy; begin case TypeKind of BORDEBUG_LF_MODIFIER : begin Dispose(FInfoRec.MODIFIERType); end; BORDEBUG_LF_POINTER : begin Dispose(FInfoRec.POINTERType); end; BORDEBUG_LF_ARRAY : begin Dispose(FInfoRec.ARRAYType); end; BORDEBUG_LF_STRUCT, BORDEBUG_LF_CLASS : begin Dispose(FInfoRec.CLASSType); end; BORDEBUG_LF_UNION : begin Dispose(FInfoRec.UNIONType); end; BORDEBUG_LF_ENUM : begin Dispose(FInfoRec.ENUMType); end; BORDEBUG_LF_PROCEDURE : begin Dispose(FInfoRec.PROCEDUREType); end; BORDEBUG_LF_MFUNCTION : begin Dispose(FInfoRec.MFUNCTIONType); end; BORDEBUG_LF_VTSHAPE : begin FreeMem(FInfoRec.VTSHAPEType^.DescriptorArray); Dispose(FInfoRec.VTSHAPEType); end; BORDEBUG_LF_LABEL : begin Dispose(FInfoRec.LABELType); end; BORDEBUG_LF_SET : begin Dispose(FInfoRec.SETType); end; BORDEBUG_LF_SUBRANGE : begin Dispose(FInfoRec.SUBRANGEType); end; BORDEBUG_LF_PARRAY : begin Dispose(FInfoRec.PARRAYType); end; BORDEBUG_LF_PSTRING : begin Dispose(FInfoRec.PSTRINGType); end; BORDEBUG_LF_CLOSURE : begin Dispose(FInfoRec.CLOSUREType); end; BORDEBUG_LF_PROPERTY : begin Dispose(FInfoRec.PROPERTYType); end; BORDEBUG_LF_LSTRING : begin Dispose(FInfoRec.LSTRINGType); end; BORDEBUG_LF_VARIANT : begin Dispose(FInfoRec.VARIANTType); end; BORDEBUG_LF_CLASSREF : begin Dispose(FInfoRec.CLASSREFType); end; BORDEBUG_LF_WSTRING : begin Dispose(FInfoRec.WSTRINGType); end; BORDEBUG_LF_ARGLIST : begin FreeMem(FInfoRec.ARGLISTType^.TypeArray); Dispose(FInfoRec.ARGLISTType); end; BORDEBUG_LF_DERIVED : begin FreeMem(FInfoRec.DERIVEDType^.DerivedTypes); Dispose(FInfoRec.DERIVEDType); end; BORDEBUG_LF_BITFIELD : begin Dispose(FInfoRec.BITFIELDType); end; BORDEBUG_LF_METHODLIST : begin FreeMem(FInfoRec.METHODLISTType^.TypeArray); FreeMem(FInfoRec.METHODLISTType^.AttribArray); FreeMem(FInfoRec.METHODLISTType^.BrowserArray); FreeMem(FInfoRec.METHODLISTType^.VtabOffArray); Dispose(FInfoRec.METHODLISTType); end; BORDEBUG_LF_BCLASS : begin Dispose(FInfoRec.BCLASSType); end; BORDEBUG_LF_VBCLASS : begin Dispose(FInfoRec.VBCLASSType); end; BORDEBUG_LF_IVBCLASS : begin Dispose(FInfoRec.IVBCLASSType); end; BORDEBUG_LF_ENUMERATE : begin Dispose(FInfoRec.ENUMERATEType); end; BORDEBUG_LF_FRIENDFCN : begin Dispose(FInfoRec.FRIENDFCNType); end; BORDEBUG_LF_INDEX : begin Dispose(FInfoRec.INDEXTypeR); end; BORDEBUG_LF_MEMBER : begin Dispose(FInfoRec.MEMBERType); end; BORDEBUG_LF_STMEMBER : begin Dispose(FInfoRec.STMEMBERType); end; BORDEBUG_LF_METHOD : begin Dispose(FInfoRec.METHODType); end; BORDEBUG_LF_NESTTYPE : begin Dispose(FInfoRec.NESTTYPEType); end; BORDEBUG_LF_VFUNCTAB : begin Dispose(FInfoRec.VFUNCTABType); end; BORDEBUG_LF_FRIENDCLS : begin Dispose(FInfoRec.FRIENDCLSType); end; BORDEBUG_LF_CHAR : begin Dispose(FInfoRec.CHARType); end; BORDEBUG_LF_SHORT : begin Dispose(FInfoRec.SHORTType); end; BORDEBUG_LF_USHORT : begin Dispose(FInfoRec.USHORTType); end; BORDEBUG_LF_LONG : begin Dispose(FInfoRec.LONGType); end; BORDEBUG_LF_ULONG : begin Dispose(FInfoRec.ULONGType); end; BORDEBUG_LF_REAL32 : begin Dispose(FInfoRec.REAL32Type); end; BORDEBUG_LF_REAL64 : begin Dispose(FInfoRec.REAL64Type); end; BORDEBUG_LF_REAL80 : begin Dispose(FInfoRec.REAL80Type); end; BORDEBUG_LF_QUADWORD : begin Dispose(FInfoRec.QUADWORDType); end; BORDEBUG_LF_UQUADWORD : begin Dispose(FInfoRec.UQUADWORDType); end; BORDEBUG_LF_REAL48 : begin Dispose(FInfoRec.REAL48Type); end; end; // We could have avoided all the Dispose-calls above by doing: // // FreeMem(FInfoRec.TypePtr) // // But if we later add strings, variants, interfaces or other auto-managed // fields that must be finalized, the code would break (i.e. leak) FInfoRec.TypePtr := nil; inherited Destroy; end; function TTypeInfo.GetNameIndex: TNameIndex; begin case TypeKind of BORDEBUG_LF_ARRAY : Result := FInfoRec.ARRAYType^.NameIndex; BORDEBUG_LF_STRUCT, BORDEBUG_LF_CLASS : Result := FInfoRec.CLASSType^.NameIndex; BORDEBUG_LF_UNION : Result := FInfoRec.UNIONType^.NameIndex; BORDEBUG_LF_ENUM : Result := FInfoRec.ENUMType^.NameIndex; BORDEBUG_LF_SET : Result := FInfoRec.SETType^.NameIndex; BORDEBUG_LF_SUBRANGE : Result := FInfoRec.SUBRANGEType^.NameIndex; BORDEBUG_LF_PARRAY : Result := FInfoRec.PARRAYType^.NameIndex; BORDEBUG_LF_PSTRING : Result := FInfoRec.PSTRINGType^.NameIndex; BORDEBUG_LF_LSTRING : Result := FInfoRec.LSTRINGType^.NameIndex; BORDEBUG_LF_VARIANT : Result := FInfoRec.VARIANTType^.NameIndex; BORDEBUG_LF_WSTRING : Result := FInfoRec.WSTRINGType^.NameIndex; BORDEBUG_LF_ENUMERATE : Result := FInfoRec.ENUMERATEType^.NameIndex; BORDEBUG_LF_FRIENDFCN : Result := FInfoRec.FRIENDFCNType^.NameIndex; BORDEBUG_LF_MEMBER : Result := FInfoRec.MEMBERType^.NameIndex; BORDEBUG_LF_STMEMBER : Result := FInfoRec.STMEMBERType^.NameIndex; BORDEBUG_LF_METHOD : Result := FInfoRec.METHODType^.NameIndex; BORDEBUG_LF_NESTTYPE : Result := FInfoRec.NESTTYPEType^.NameIndex; else Result := -1; end; end; function TTypeInfo.GetKindAsString: string; begin Result := TypeKindToString(TypeKind); end; end.